diff --git a/CCommon.pas b/CCommon.pas index a615625..add3ed3 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -150,6 +150,14 @@ type cgReal,cgDouble,cgComp,cgExtended,cgString, cgVoid,ccPointer); + { Basic types (plus the void type) as defined by the C language. } + { This differs from baseTypeEnum in that different types with the } + { same representation are distinguished from each other. } + + cTypeEnum = (ctChar, ctSChar, ctUChar, ctShort, ctUShort, ctInt, ctUInt, + ctLong, ctULong, ctFloat, ctDouble, ctLongDouble, ctComp, + ctVoid); + {tokens} {------} {Note: tokenEnum is duplicated in } @@ -266,7 +274,8 @@ type isConstant: boolean; {is the type a constant?} saveDisp: longint; {disp in symbol file} case kind: typeKind of {NOTE: aType,pType and fType must overlap} - scalarType : (baseType: baseTypeEnum;); + scalarType : (baseType: baseTypeEnum; {our internal type representation} + cType: cTypeEnum); {type in the C type system} arrayType : (aType: typePtr; elements: longint; ); diff --git a/Expression.pas b/Expression.pas index 6752380..3e6995e 100644 --- a/Expression.pas +++ b/Expression.pas @@ -374,13 +374,13 @@ if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin end {else if} else {one operand is unsigned in and the other is int} begin UsualBinaryConversions := cgUWord; - expressionType := uWordPtr; + expressionType := uIntPtr; end; {else} end {if} else begin {types are the same} UsualBinaryConversions := lt; if lt = cgWord then {update types that may have changed} - expressionType := wordPtr + expressionType := intPtr else if lt = cgExtended then expressionType := extendedPtr; end; {else} @@ -413,7 +413,7 @@ if expressionType^.kind = scalarType then begin et := Unary(expressionType^.baseType); UsualUnaryConversions := et; if et = cgWord then {update types that may have changed} - expressionType := wordPtr + expressionType := intPtr else if et = cgExtended then expressionType := extendedPtr; end {if} @@ -819,7 +819,7 @@ var {fnPtr^.saveDisp := 0;} {fnPtr^.isConstant := false;} fnPtr^.kind := functionType; - fnPtr^.fType := wordPtr; + fnPtr^.fType := intPtr; {fnPtr^.varargs := false;} {fnPtr^.prototyped := false;} {fnPtr^.overrideKR := false;} @@ -1722,7 +1722,7 @@ if expressionType^.kind = scalarType then begin otherwise: Error(47); end; {case} - expressionType := wordPtr; + expressionType := intPtr; Gen0t(op, bt); end {if} else @@ -1947,7 +1947,7 @@ var ip: identPtr; {for scanning for the field} begin {DoSelection} -expressionType := wordPtr; {set defaults in case there is an error} +expressionType := intPtr; {set defaults in case there is an error} size := 0; if tree^.token.class = identifier then begin while lType^.kind = definedType do @@ -2260,7 +2260,7 @@ var else if ExpressionKind(tree) in [arrayType,pointerType] then GenerateCode(tree) else begin - expressionType := wordPtr; {set default type in case of error} + expressionType := intPtr; {set default type in case of error} if doDispose then {prevent spurious errors} Error(78); end; {else} @@ -2805,7 +2805,7 @@ case tree^.token.kind of enumConst: begin Gen1t(pc_ldc, tree^.id^.itype^.eval, cgWord); - expressionType := wordPtr; + expressionType := intPtr; end; end; {case} @@ -2816,9 +2816,9 @@ case tree^.token.kind of lastwasconst := true; lastconst := tree^.token.ival; if tree^.token.kind = intConst then - expressionType := wordPtr + expressionType := intPtr else - expressionType := uwordPtr; + expressionType := uIntPtr; end; {case intConst} longConst,ulongConst: begin @@ -3134,7 +3134,7 @@ case tree^.token.kind of else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); - expressionType := wordPtr; + expressionType := intPtr; end; {if} lType := expressionType; GenerateCode(tree^.right); @@ -3143,7 +3143,7 @@ case tree^.token.kind of else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); - expressionType := wordPtr; + expressionType := intPtr; end; {if} case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: @@ -3153,7 +3153,7 @@ case tree^.token.kind of otherwise: error(66); end; {case} - expressionType := wordPtr; + expressionType := intPtr; end; {case barbarop} andandop: begin {&&} @@ -3163,7 +3163,7 @@ case tree^.token.kind of else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); - expressionType := wordPtr; + expressionType := intPtr; end; {if} lType := expressionType; GenerateCode(tree^.right); @@ -3172,7 +3172,7 @@ case tree^.token.kind of else if UsualUnaryConversions = cgExtended then begin GenLdcReal(0.0); Gen0t(pc_neq, cgExtended); - expressionType := wordPtr; + expressionType := intPtr; end; {if} case UsualBinaryConversions(lType) of cgByte,cgUByte,cgWord,cgUWord: @@ -3182,7 +3182,7 @@ case tree^.token.kind of otherwise: error(66); end; {case} - expressionType := wordPtr; + expressionType := intPtr; end; {case andandop} carotch: begin {^} @@ -3472,7 +3472,7 @@ case tree^.token.kind of Gen0t(pc_equ, UsualBinaryConversions(lType)) else Gen0t(pc_neq, UsualBinaryConversions(lType)); - expressionType := wordPtr; + expressionType := intPtr; end; {case exceqop,eqeqop} lteqop, {<=} @@ -3491,7 +3491,7 @@ case tree^.token.kind of Gen0t(pc_les, UsualBinaryConversions(lType)) else {if tree^.token.kind = gtch then} Gen0t(pc_grt, UsualBinaryConversions(lType)); - expressionType := wordPtr; + expressionType := intPtr; end; {case lteqop,gteqop,ltch,gtch} uminus: begin {unary -} @@ -3546,7 +3546,7 @@ case tree^.token.kind of otherwise: error(66); end; {case} - expressionType := wordPtr; + expressionType := intPtr; end; {case excch} plusplusop: {prefix ++} @@ -3754,7 +3754,7 @@ if kind = normalExpression then begin {generate code from the expression tree} GenerateCode(tree); end {if} else - expressionType := wordPtr; {set default type in case of error} + expressionType := intPtr; {set default type in case of error} end {if} else begin {record the expression for an initializer} initializerTree := tree; @@ -3762,7 +3762,7 @@ else begin {record the expression for an initialize if errorFound then begin DisposeTree(initializerTree); initializerTree := nil; - expressionType := wordPtr; {set default type in case of error} + expressionType := intPtr; {set default type in case of error} end {if} else begin ldoDispose := doDispose; {find the expression type} @@ -3795,13 +3795,13 @@ else begin {record the expression for an initialize end; {if} if tree^.token.kind = intconst then begin expressionValue := tree^.token.ival; - expressionType := wordPtr; + expressionType := intPtr; isConstant := true; end {else if} else if tree^.token.kind = uintconst then begin expressionValue := tree^.token.ival; expressionValue := expressionValue & $0000FFFF; - expressionType := uwordPtr; + expressionType := uIntPtr; isConstant := true; end {else if} else if tree^.token.kind = longconst then begin @@ -3819,7 +3819,7 @@ else begin {record the expression for an initialize expressionType := extendedPtr; isConstant := true; if kind in [arrayExpression,preprocessorExpression] then begin - expressionType := wordPtr; + expressionType := intPtr; expressionValue := 1; Error(47); end; {if} @@ -3829,7 +3829,7 @@ else begin {record the expression for an initialize expressionType := stringTypePtr; isConstant := true; if kind in [arrayExpression,preprocessorExpression] then begin - expressionType := wordPtr; + expressionType := intPtr; expressionValue := 1; Error(47); end; {if} diff --git a/Header.pas b/Header.pas index 77d9191..ad434a8 100644 --- a/Header.pas +++ b/Header.pas @@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI; {$segment 'SCANNER'} const - symFileVersion = 7; {version number of .sym file format} + symFileVersion = 8; {version number of .sym file format} var inhibitHeader: boolean; {should .sym includes be blocked?} @@ -969,19 +969,19 @@ procedure EndInclude {chPtr: ptr}; begin {WriteType} - if tp = bytePtr then + if tp = sCharPtr then WriteByte(2) - else if tp = uBytePtr then + else if tp = charPtr then WriteByte(3) - else if tp = wordPtr then + else if tp = intPtr then WriteByte(4) - else if tp = uWordPtr then + else if tp = uIntPtr then WriteByte(5) else if tp = longPtr then WriteByte(6) else if tp = uLongPtr then WriteByte(7) - else if tp = realPtr then + else if tp = floatPtr then WriteByte(8) else if tp = doublePtr then WriteByte(9) @@ -995,6 +995,12 @@ procedure EndInclude {chPtr: ptr}; WriteByte(13) else if tp = defaultStruct then WriteByte(14) + else if tp = uCharPtr then + WriteByte(15) + else if tp = shortPtr then + WriteByte(16) + else if tp = uShortPtr then + WriteByte(17) else if tp^.saveDisp <> 0 then begin WriteByte(1); WriteLong(tp^.saveDisp); @@ -1006,8 +1012,10 @@ procedure EndInclude {chPtr: ptr}; WriteByte(ord(tp^.isConstant)); WriteByte(ord(tp^.kind)); case tp^.kind of - scalarType: + scalarType: begin WriteByte(ord(tp^.baseType)); + WriteByte(ord(tp^.cType)); + end; arrayType: begin WriteLong(tp^.elements); @@ -1612,8 +1620,10 @@ var tp^.isConstant := boolean(ReadByte); tp^.kind := typeKind(ReadByte); case tp^.kind of - scalarType: + scalarType: begin tp^.baseType := baseTypeEnum(ReadByte); + tp^.cType := cTypeEnum(ReadByte); + end; arrayType: begin tp^.elements := ReadLong; @@ -1676,19 +1686,22 @@ var end; {if} end; {case 1} - 2: tp := bytePtr; - 3: tp := uBytePtr; - 4: tp := wordPtr; - 5: tp := uWordPtr; + 2: tp := sCharPtr; + 3: tp := charPtr; + 4: tp := intPtr; + 5: tp := uIntPtr; 6: tp := longPtr; 7: tp := uLongPtr; - 8: tp := realPtr; + 8: tp := floatPtr; 9: tp := doublePtr; 10: tp := extendedPtr; 11: tp := stringTypePtr; 12: tp := voidPtr; 13: tp := voidPtrPtr; 14: tp := defaultStruct; + 15: tp := uCharPtr; + 16: tp := shortPtr; + 17: tp := uShortPtr; end; {case} end; {ReadType} diff --git a/Parser.pas b/Parser.pas index eb4e0e0..5934d02 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1862,7 +1862,7 @@ var else begin Error(47); errorFound := true; - Subscript := wordPtr; + Subscript := intPtr; end; {else} end {if} else if tree^.token.kind = dotch then begin @@ -1879,7 +1879,7 @@ var else begin Error(47); errorFound := true; - Subscript := wordPtr; + Subscript := intPtr; end; {else} end {else if} else if tree^.token.kind = ident then begin @@ -1887,7 +1887,7 @@ var if ip = nil then begin Error(31); errorFound := true; - Subscript := wordPtr; + Subscript := intPtr; iPtr^.pName := @'?'; end {if} else begin @@ -1898,7 +1898,7 @@ var else begin Error(47); errorFound := true; - Subscript := wordPtr; + Subscript := intPtr; end; {else} end; {Subscript} @@ -2239,7 +2239,7 @@ var {fill a structure} if variable^.storage in [external,global,private] then - Fill(count * tp^.size, bytePtr) + Fill(count * tp^.size, sCharPtr) else begin i := count; while i <> 0 do begin @@ -2256,7 +2256,7 @@ var {fill a union} if variable^.storage in [external,global,private] then - Fill(count * tp^.size, bytePtr) + Fill(count * tp^.size, sCharPtr) else Fill(count, tp^.fieldList^.iType); end {else if} @@ -2364,7 +2364,7 @@ var iPtr^.sval := token.sval; count := tp^.elements - token.sval^.length; if count <> 0 then - Fill(count, bytePtr); + Fill(count, sCharPtr); end {if} else begin iPtr^.isConstant := false; @@ -2477,7 +2477,7 @@ var end; {if} if count > 0 then if variable^.storage in [external,global,private] then - Fill(count, bytePtr); + Fill(count, sCharPtr); printMacroExpansions := lPrintMacroExpansions; end {if} else {struct/union assignment initializer} @@ -2767,33 +2767,33 @@ var if typeSpecifiers = [voidsy] then myTypeSpec := voidPtr else if typeSpecifiers = [charsy] then - myTypeSpec := uBytePtr + myTypeSpec := charPtr else if typeSpecifiers = [signedsy,charsy] then - myTypeSpec := bytePtr + myTypeSpec := sCharPtr else if typeSpecifiers = [unsignedsy,charsy] then - myTypeSpec := uBytePtr + myTypeSpec := uCharPtr else if (typeSpecifiers = [shortsy]) or (typeSpecifiers = [signedsy,shortsy]) or (typeSpecifiers = [shortsy,intsy]) or (typeSpecifiers = [signedsy,shortsy,intsy]) then - myTypeSpec := wordPtr + myTypeSpec := shortPtr else if (typeSpecifiers = [unsignedsy,shortsy]) or (typeSpecifiers = [unsignedsy,shortsy,intsy]) then - myTypeSpec := uWordPtr + myTypeSpec := uShortPtr else if (typeSpecifiers = [intsy]) or (typeSpecifiers = [signedsy]) or (typeSpecifiers = [signedsy,intsy]) then begin if unix_1 then myTypeSpec := longPtr else - myTypeSpec := wordPtr; + myTypeSpec := intPtr; end {else if} else if (typeSpecifiers = [unsignedsy]) or (typeSpecifiers = [unsignedsy,intsy]) then begin if unix_1 then myTypeSpec := uLongPtr else - myTypeSpec := uWordPtr; + myTypeSpec := uIntPtr; end {else if} else if (typeSpecifiers = [longsy]) or (typeSpecifiers = [signedsy,longsy]) @@ -2804,18 +2804,17 @@ var or (typeSpecifiers = [unsignedsy,longsy,intsy]) then myTypeSpec := uLongPtr else if typeSpecifiers = [floatsy] then - myTypeSpec := realPtr + myTypeSpec := floatPtr else if typeSpecifiers = [doublesy] then myTypeSpec := doublePtr - else if typeSpecifiers = [longsy,doublesy] then + else if (typeSpecifiers = [longsy,doublesy]) + or (typeSpecifiers = [extendedsy]) then myTypeSpec := extendedPtr else if typeSpecifiers = [compsy] then myTypeSpec := compPtr - else if typeSpecifiers = [extendedsy] then - myTypeSpec := extendedPtr else if typeSpecifiers = [_Boolsy] then begin Error(135); - myTypeSpec := wordPtr; + myTypeSpec := intPtr; end {else if} else UnexpectedTokenError(expectedNext); @@ -3009,7 +3008,7 @@ while token.kind in allowedTokens do begin end; {else} end; {if} 1: mySkipDeclarator := token.kind = semicolonch; - myTypeSpec := wordPtr; + myTypeSpec := intPtr; typeDone := true; end; @@ -3147,7 +3146,7 @@ skipDeclarator := mySkipDeclarator; typeSpec := myTypeSpec; declarationModifiers := myDeclarationModifiers; if typeSpec = nil then begin - typeSpec := wordPtr; {under C89, default type is int} + typeSpec := intPtr; {under C89, default type is int} if (lint & lintC99Syntax) <> 0 then Error(151); end; {if} @@ -3592,7 +3591,7 @@ if isFunction then begin tlp := lp; while tlp <> nil do begin if tlp^.itype = nil then begin - tlp^.itype := wordPtr; + tlp^.itype := intPtr; if (lint & lintC99Syntax) <> 0 then if (lint & lintNotPrototyped) = 0 then Error(147); {C99+ require K&R params to be declared} diff --git a/Symbol.pas b/Symbol.pas index 6ab2321..8d2215f 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -25,17 +25,19 @@ { noDeclarations - have we declared anything at this level? } { table - current symbol table } { } -{ bytePtr - pointer to the base type for bytes } -{ uBytePtr - pointer to the base type for unsigned bytes } -{ wordPtr - pointer to the base type for words } -{ uWordPtr - pointer to the base type for unsigned words } -{ longPtr - pointer to the base type for long words } -{ uLongPtr - pointer to the base type for unsigned long words } -{ realPtr - pointer to the base type for reals } -{ doublePtr - pointer to the base type for double precision } -{ reals } -{ compPtr - pointer to the base type for comp reals } -{ extendedPtr - pointer to the base type for extended reals } +{ charPtr - pointer to the base type for char } +{ sCharPtr - pointer to the base type for signed char } +{ uCharPtr - pointer to the base type for unsigned char } +{ shortPtr - pointer to the base type for short } +{ uShortPtr - pointer to the base type for unsigned short } +{ intPtr - pointer to the base type for int } +{ uIntPtr - pointer to the base type for unsigned int } +{ longPtr - pointer to the base type for long } +{ uLongPtr - pointer to the base type for unsigned long } +{ floatPtr - pointer to the base type for float } +{ doublePtr - pointer to the base type for double } +{ compPtr - pointer to the base type for comp } +{ extendedPtr - pointer to the base type for extended } { voidPtr - pointer to the base type for void } { voidPtrPtr - typeless pointer, for some type casting } { stringTypePtr - pointer to the base type for string } @@ -69,9 +71,10 @@ var noDeclarations: boolean; {have we declared anything at this level?} table: symbolTablePtr; {current symbol table} globalTable: symbolTablePtr; {global symbol table} - - bytePtr,uBytePtr,wordPtr,uWordPtr, {base types} - longPtr,uLongPtr,realPtr,doublePtr,compPtr,extendedPtr, + + {base types} + charPtr,sCharPtr,uCharPtr,shortPtr,uShortPtr,intPtr,uIntPtr, + longPtr,uLongPtr,floatPtr,doublePtr,compPtr,extendedPtr, stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr; {---------------------------------------------------------------} @@ -381,9 +384,10 @@ else scalarType: if kind2 = scalarType then - CompTypes := t1^.baseType = t2^.baseType + CompTypes := + (t1^.baseType = t2^.baseType) and (t1^.cType = t2^.cType) else if kind2 = enumType then - CompTypes := t1^.baseType = cgWord; + CompTypes := (t1^.baseType = cgWord) and (t1^.cType = ctInt); arrayType: if kind2 = arrayType then begin @@ -417,7 +421,7 @@ else enumType: if kind2 = scalarType then - CompTypes := t2^.baseType = cgWord + CompTypes := (t2^.baseType = cgWord) and (t2^.cType = ctInt) else if kind2 = enumType then CompTypes := true; @@ -986,7 +990,7 @@ var case tp^.kind of scalarType: WriteScalarType(tp, $80, subscripts); enumType, - functionType: WriteScalarType(wordPtr, $80, subscripts); + functionType: WriteScalarType(intPtr, $80, subscripts); otherwise: begin CnOut(11); CnOut2(subscripts); @@ -1050,7 +1054,7 @@ var else WriteScalarType(tp2, 0, count) else if tp2^.kind = enumType then - WriteScalarType(wordPtr, 0, count) + WriteScalarType(intPtr, 0, count) else if tp2^.kind = pointerType then WritePointerType(tp2, count) else begin @@ -1133,7 +1137,7 @@ var WriteAddress(ip); {write the address field} case tPtr^.kind of scalarType: WriteScalarType(tPtr, 0, 0); - enumType: WriteScalarType(wordPtr, 0, 0); + enumType: WriteScalarType(intPtr, 0, 0); pointerType: begin WritePointerType(tPtr, 0); ExpandPointerType(tPtr); @@ -1192,37 +1196,68 @@ PushTable; globalTable := table; noDeclarations := false; {declare base types} -new(bytePtr); {byte} -with bytePtr^ do begin +new(sCharPtr); {signed char} +with sCharPtr^ do begin size := cgByteSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgByte; + cType := ctSChar; end; {with} -new(uBytePtr); {unsigned byte} -with uBytePtr^ do begin +new(charPtr); {char} +with charPtr^ do begin size := cgByteSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgUByte; + cType := ctChar; end; {with} -new(wordPtr); {word} -with wordPtr^ do begin +new(uCharPtr); {unsigned char} +with uCharPtr^ do begin + size := cgByteSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgUByte; + cType := ctUChar; + end; {with} +new(shortPtr); {short} +with shortPtr^ do begin size := cgWordSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgWord; + cType := ctShort; end; {with} -new(uWordPtr); {unsigned word} -with uWordPtr^ do begin +new(uShortPtr); {unsigned short} +with uShortPtr^ do begin size := cgWordSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgUWord; + cType := ctUShort; + end; {with} +new(intPtr); {int} +with intPtr^ do begin + size := cgWordSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgWord; + cType := ctInt; + end; {with} +new(uIntPtr); {unsigned int} +with uIntPtr^ do begin + size := cgWordSize; + saveDisp := 0; + isConstant := false; + kind := scalarType; + baseType := cgUWord; + cType := ctUInt; end; {with} new(longPtr); {long} with longPtr^ do begin @@ -1231,6 +1266,7 @@ with longPtr^ do begin isConstant := false; kind := scalarType; baseType := cgLong; + cType := ctLong; end; {with} new(uLongPtr); {unsigned long} with uLongPtr^ do begin @@ -1239,14 +1275,16 @@ with uLongPtr^ do begin isConstant := false; kind := scalarType; baseType := cgULong; + cType := ctULong; end; {with} -new(realPtr); {real} -with realPtr^ do begin +new(floatPtr); {real} +with floatPtr^ do begin size := cgRealSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgReal; + cType := ctFloat; end; {with} new(doublePtr); {double} with doublePtr^ do begin @@ -1255,6 +1293,7 @@ with doublePtr^ do begin isConstant := false; kind := scalarType; baseType := cgDouble; + cType := ctDouble; end; {with} new(compPtr); {comp} with compPtr^ do begin @@ -1263,14 +1302,16 @@ with compPtr^ do begin isConstant := false; kind := scalarType; baseType := cgComp; + cType := ctComp; end; {with} -new(extendedPtr); {extended} +new(extendedPtr); {extended, aka long double} with extendedPtr^ do begin size := cgExtendedSize; saveDisp := 0; isConstant := false; kind := scalarType; baseType := cgExtended; + cType := ctLongDouble; end; {with} new(stringTypePtr); {string constant type} with stringTypePtr^ do begin @@ -1278,7 +1319,7 @@ with stringTypePtr^ do begin saveDisp := 0; isConstant := false; kind := arrayType; - aType := uBytePtr; + aType := charPtr; elements := 1; end; {with} new(voidPtr); {void} @@ -1288,6 +1329,7 @@ with voidPtr^ do begin isConstant := false; kind := scalarType; baseType := cgVoid; + cType := ctVoid; end; {with} new(voidPtrPtr); {typeless pointer} with voidPtrPtr^ do begin @@ -1308,7 +1350,7 @@ with defaultStruct^ do begin {(for structures with errors)} with fieldlist^ do begin next := nil; name := @'field'; - itype := wordPtr; + itype := intPtr; class := ident; state := declared; disp := 0;