mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-09-11 03:54:45 +00:00
1fa3ec8fdd
They are now represented in local structures instead. This keeps the representation of declaration specifiers together and eliminates the need for awkward and error-prone code to save and restore the global variables.
4917 lines
183 KiB
ObjectPascal
4917 lines
183 KiB
ObjectPascal
{$optimize 1}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ Expression }
|
|
{ }
|
|
{ Evaluate expressions }
|
|
{ }
|
|
{ Note: The expression evaluator uses the scanner to fetch }
|
|
{ tokens, but IT IS ALSO USED BY THE SCANNER to evaluate }
|
|
{ expressions in preprocessor commands. This circular }
|
|
{ dependency is handle by defining all of the expression }
|
|
{ evaluator's external types, constants, and variables in the }
|
|
{ CCOMMON module. The only procedure from this module used by }
|
|
{ the scanner is Expression, which is declared as an external }
|
|
{ procedure in the scanner. }
|
|
{ }
|
|
{ External Variables: }
|
|
{ }
|
|
{ startExpression - tokens that may start an expression }
|
|
{ bitDisp,bitSize - bit field disp, size }
|
|
{ unsigned - is the bit field unsigned? }
|
|
{ isBitField - is the field a bit field? }
|
|
{ }
|
|
{ External Subroutines: }
|
|
{ }
|
|
{ AssignmentConversion - do type checking and conversions for }
|
|
{ assignment statements }
|
|
{ CompareToZero - Compare the result on tos to zero. }
|
|
{ DisposeTree - dispose of an expression tree }
|
|
{ DoSelection - Find the displacement & type for a }
|
|
{ selection operation }
|
|
{ Expression - handle an expression }
|
|
{ FreeTemp - place a temporary label in the available label }
|
|
{ list }
|
|
{ GenerateCode - generate code from a fully formed expression }
|
|
{ tree }
|
|
{ GetTemp - find a temporary work variable }
|
|
{ InitExpression - initialize the expression handler }
|
|
{ UsualBinaryConversions - performs the usual binary }
|
|
{ conversions }
|
|
{ UsualUnaryConversions - performs the usual unary conversions }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit Expression;
|
|
|
|
{$LibPrefix '0/obj/'}
|
|
|
|
interface
|
|
|
|
uses CCommon, Table, CGI, Scanner, Symbol, MM, Printf;
|
|
|
|
{$segment 'EXP'}
|
|
|
|
var
|
|
startExpression: tokenSet; {tokens that can start an expression}
|
|
|
|
{set by DoSelection}
|
|
{------------------}
|
|
bitDisp,bitSize: integer; {bit field disp, size}
|
|
unsigned: boolean; {is the bit field unsigned?}
|
|
isBitField: boolean; {is the field a bit field?}
|
|
|
|
{misc}
|
|
{----}
|
|
lastwasconst: boolean; {did the last GenerateCode result in an integer constant?}
|
|
lastconst: longint; {last integer constant from GenerateCode}
|
|
lastWasNullPtrConst: boolean; {did last GenerateCode give a null ptr const?}
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure AssignmentConversion (t1, t2: typePtr; isConstant: boolean;
|
|
value: longint; genCode, checkConst: boolean);
|
|
|
|
{ TOS is of type t2, and is about to be stored to a variable of }
|
|
{ type t1 by an assignment or a return statement. Make sure }
|
|
{ this is legal, and do any necessary type conversions on t2, }
|
|
{ which is on the top of the evaluation stack. Flag an error }
|
|
{ if the conversion is illegal. }
|
|
{ }
|
|
{ parameters: }
|
|
{ t1 - type of the variable }
|
|
{ t2 - type of the expression }
|
|
{ isConstant - is the rhs a constant? }
|
|
{ value - if isConstant = true, then this is the value }
|
|
{ genCode - should conversion code be generated? }
|
|
{ checkConst - check for assignments to constants? }
|
|
|
|
|
|
procedure CompareToZero(op: pcodes);
|
|
|
|
{ Compare the result on tos to zero. }
|
|
{ }
|
|
{ This procedure is used by the logical statements to compare }
|
|
{ _any_ scalar result to zero, giving a boolean result. }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation to use on the compare }
|
|
|
|
|
|
procedure DisposeTree (tree: tokenPtr);
|
|
|
|
{ dispose of an expression tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - head of the expression tree to dispose of }
|
|
|
|
|
|
procedure DoSelection (lType: typePtr; tree: tokenPtr; var size: longint);
|
|
|
|
{ Find the displacement & type for a selection operation }
|
|
{ }
|
|
{ parameters: }
|
|
{ lType - structure/union type }
|
|
{ id - tag field name }
|
|
{ size - disp into the structure/union }
|
|
{ }
|
|
{ returned in non-local variables: }
|
|
{ bitDisp - displacement to bit field }
|
|
{ bitSize - size of bit field }
|
|
{ unsigned - is the bit field unsigned? }
|
|
{ isBitField - is the field a bit field? }
|
|
{ }
|
|
{ variables: }
|
|
{ expressionType - set to the type of the field }
|
|
|
|
|
|
procedure Expression (kind: expressionKind; stopSym: tokenSet);
|
|
|
|
{ handle an expression }
|
|
{ }
|
|
{ parameters: }
|
|
{ kind - Kind of expression; determines what operations }
|
|
{ and what kind of operands are allowed. }
|
|
{ stopSym - Set of symbols that can mark the end of an }
|
|
{ expression; used to skip tokens after syntax }
|
|
{ errors and to block certain operations. For }
|
|
{ example, the comma operator is not allowed in }
|
|
{ an expression when evaluating a function }
|
|
{ parameter list. }
|
|
{ }
|
|
{ variables: }
|
|
{ realExpressionValue - value of a real constant }
|
|
{ expression }
|
|
{ expressionValue - value of a constant expression }
|
|
{ expressionType - type of the constant expression }
|
|
|
|
|
|
procedure FreeTemp(labelNum, size: integer);
|
|
|
|
{ place a temporary label in the available label list }
|
|
{ }
|
|
{ parameters: }
|
|
{ labelNum - number of the label to free }
|
|
{ size - size of the variable }
|
|
{ }
|
|
{ variables: }
|
|
{ tempList - list of free labels }
|
|
|
|
|
|
procedure GenerateCode (tree: tokenPtr);
|
|
|
|
{ generate code from a fully formed expression tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - top of the expression tree to generate code from }
|
|
{ }
|
|
{ variables: }
|
|
{ expressionType - result type of the expression }
|
|
|
|
|
|
function GetTemp(size: integer): integer;
|
|
|
|
{ find a temporary work variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ size - size of the variable }
|
|
{ }
|
|
{ variables: }
|
|
{ tempList - list of free labels }
|
|
{ }
|
|
{ Returns the label number. }
|
|
|
|
|
|
procedure InitExpression;
|
|
|
|
{ initialize the expression handler }
|
|
|
|
|
|
function UsualBinaryConversions (lType: typePtr): baseTypeEnum;
|
|
|
|
{ performs the usual binary conversions }
|
|
{ }
|
|
{ inputs: }
|
|
{ lType - type of the left operand }
|
|
{ expressionType - type of the right operand }
|
|
{ }
|
|
{ result: }
|
|
{ The base type of the operation to perform is }
|
|
{ returned. Any conversion code necessary has been }
|
|
{ generated. }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
|
|
function UsualUnaryConversions: baseTypeEnum;
|
|
|
|
{ performs the usual unary conversions }
|
|
{ }
|
|
{ inputs: }
|
|
{ expressionType - type of the operand }
|
|
{ }
|
|
{ result: }
|
|
{ The base type of the operation to perform is returned. }
|
|
{ Any conversion code necessary has been generated. }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
procedure GetLLExpressionValue (var val: longlong);
|
|
|
|
{ get the value of the last integer constant expression as a }
|
|
{ long long (whether it had long long type or not). }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
const
|
|
{notAnOperation is also used in TABLE.ASM}
|
|
notAnOperation = 200; {used as the icp for non-operation tokens}
|
|
|
|
var
|
|
{structured constants}
|
|
{--------------------}
|
|
startTerm: tokenSet; {tokens that can start a term}
|
|
|
|
{misc}
|
|
{----}
|
|
errorFound: boolean; {was there are error during generation?}
|
|
|
|
{-- Procedures imported from the parser ------------------------}
|
|
|
|
procedure Match (kind: tokenEnum; err: integer); extern;
|
|
|
|
{ insure that the next token is of the specified type }
|
|
{ }
|
|
{ parameters: }
|
|
{ kind - expected token kind }
|
|
{ err - error number if the expected token is not found }
|
|
|
|
|
|
function TypeName: typePtr; extern;
|
|
|
|
{ process a type name (used for casts and sizeof/_Alignof) }
|
|
{ }
|
|
{ returns: a pointer to the type }
|
|
|
|
|
|
function MakeFuncIdentifier: identPtr; extern;
|
|
|
|
{ Make the predefined identifier __func__. }
|
|
{ }
|
|
{ It is inserted in the symbol table as if the following }
|
|
{ declaration appeared at the beginning of the function body: }
|
|
{ }
|
|
{ static const char __func__[] = "function-name"; }
|
|
{ }
|
|
{ This must only be called within a function body. }
|
|
|
|
|
|
function MakeCompoundLiteral(tp: typePtr): identPtr; extern;
|
|
|
|
{ Make the identifier for a compound literal. }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - the type of the compound literal }
|
|
|
|
|
|
procedure AutoInit (variable: identPtr; line: integer;
|
|
isCompoundLiteral: boolean); extern;
|
|
|
|
{ generate code to initialize an auto variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - the variable to initialize }
|
|
{ line - line number (used for debugging) }
|
|
{ isCompoundLiteral - initializing a compound literal? }
|
|
|
|
{-- External unsigned math routines ----------------------------}
|
|
|
|
function lshr (x,y: longint): longint; extern;
|
|
|
|
function udiv (x,y: longint): longint; extern;
|
|
|
|
function uge (x,y: longint): longint; extern;
|
|
|
|
function ugt (x,y: longint): longint; extern;
|
|
|
|
function ule (x,y: longint): longint; extern;
|
|
|
|
function ult (x,y: longint): longint; extern;
|
|
|
|
function umod (x,y: longint): longint; extern;
|
|
|
|
function umul (x,y: longint): longint; extern;
|
|
|
|
{-- External 64-bit math routines ------------------------------}
|
|
{ Procedures for arithmetic and shifts compute "x := x OP y". }
|
|
|
|
procedure umul64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure udiv64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure div64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure umod64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure rem64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure add64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure sub64 (var x: longlong; y: longlong); extern;
|
|
|
|
procedure shl64 (var x: longlong; y: integer); extern;
|
|
|
|
procedure ashr64 (var x: longlong; y: integer); extern;
|
|
|
|
procedure lshr64 (var x: longlong; y: integer); extern;
|
|
|
|
function ult64(a,b: longlong): integer; extern;
|
|
|
|
function uge64(a,b: longlong): integer; extern;
|
|
|
|
function ule64(a,b: longlong): integer; extern;
|
|
|
|
function ugt64(a,b: longlong): integer; extern;
|
|
|
|
function slt64(a,b: longlong): integer; extern;
|
|
|
|
function sge64(a,b: longlong): integer; extern;
|
|
|
|
function sle64(a,b: longlong): integer; extern;
|
|
|
|
function sgt64(a,b: longlong): integer; extern;
|
|
|
|
{-- External conversion functions; imported from CGC.pas -------}
|
|
|
|
procedure CnvXLL (var result: longlong; val: extended); extern;
|
|
|
|
procedure CnvXULL (var result: longlong; val: extended); extern;
|
|
|
|
function CnvLLX (val: longlong): extended; extern;
|
|
|
|
function CnvULLX (val: longlong): extended; extern;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
function Unary(tp: baseTypeEnum): baseTypeEnum;
|
|
|
|
{ usual unary conversions }
|
|
{ }
|
|
{ This function returns the base type actually loaded on the }
|
|
{ stack for a particular data type. This corresponds to C's }
|
|
{ usual unary conversions. }
|
|
{ }
|
|
{ parameter: }
|
|
{ tp - data type }
|
|
{ }
|
|
{ result: }
|
|
{ Stack type. }
|
|
|
|
begin {Unary}
|
|
if tp in [cgByte,cgUByte] then
|
|
tp := cgWord;
|
|
Unary := tp;
|
|
end; {Unary}
|
|
|
|
|
|
function UsualBinaryConversions {lType: typePtr): baseTypeEnum};
|
|
|
|
{ performs the usual binary conversions }
|
|
{ }
|
|
{ inputs: }
|
|
{ lType - type of the left operand }
|
|
{ expressionType - type of the right operand }
|
|
{ }
|
|
{ result: }
|
|
{ The base type of the operation to perform is }
|
|
{ returned. Any conversion code necessary has been }
|
|
{ generated. }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
var
|
|
rType: typePtr; {right type}
|
|
lt,rt: baseTypeEnum; {work variables}
|
|
|
|
|
|
function CommonRealType (lt, rt: baseTypeEnum): baseTypeEnum;
|
|
|
|
{ Compute the common real type of two types, where at least }
|
|
{ one of the types is a real type. }
|
|
{ }
|
|
{ inputs: }
|
|
{ lt, rt - the two operand types }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
begin {CommonRealType}
|
|
if (lt = cgComp) and (rt = cgComp) then
|
|
lt := cgComp
|
|
else if (lt in [cgExtended,cgComp]) or (rt in [cgExtended,cgComp]) then
|
|
lt := cgExtended
|
|
else if (lt = cgDouble) or (rt = cgDouble) then
|
|
lt := cgDouble
|
|
else
|
|
lt := cgReal;
|
|
CommonRealType := lt;
|
|
case lt of
|
|
cgReal: expressionType := floatPtr;
|
|
cgDouble: expressionType := doublePtr;
|
|
cgExtended: expressionType := extendedPtr;
|
|
cgComp: expressionType := compPtr;
|
|
end; {case}
|
|
end; {CommonRealType}
|
|
|
|
|
|
begin {UsualBinaryConversions}
|
|
UsualBinaryConversions := cgULong;
|
|
if lType^.kind = pointerType then
|
|
lType := uLongPtr
|
|
else if lType^.kind = scalarType then
|
|
if lType^.baseType = cgVoid then begin
|
|
lType := uLongPtr;
|
|
Error(66);
|
|
end; {if}
|
|
rType := expressionType;
|
|
if rType^.kind = pointerType then
|
|
rType := uLongPtr
|
|
else if rType^.kind = scalarType then
|
|
if rType^.baseType = cgVoid then begin
|
|
rType := uLongPtr;
|
|
Error(66);
|
|
end; {if}
|
|
if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin
|
|
lt := Unary(lType^.baseType);
|
|
rt := Unary(rType^.baseType);
|
|
if lt <> rt then begin
|
|
if lt in [cgReal,cgDouble,cgExtended,cgComp] then begin
|
|
if rt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
|
|
Gen2(pc_cnv, ord(rt), ord(cgExtended));
|
|
UsualBinaryConversions := CommonRealType(lt, rt);
|
|
end {if}
|
|
else if rt in [cgReal,cgDouble,cgExtended,cgComp] then begin
|
|
if lt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
|
|
Gen2(pc_cnn, ord(lt), ord(cgExtended));
|
|
UsualBinaryConversions := CommonRealType(lt, rt);
|
|
end {else if}
|
|
else if lt = cgUQuad then begin
|
|
if rt in [cgWord,cgUWord,cgLong,cgULong] then
|
|
Gen2(pc_cnv, ord(rt), ord(cgUQuad));
|
|
UsualBinaryConversions := cgUQuad;
|
|
expressionType := uLongLongPtr;
|
|
end {else if}
|
|
else if rt = cgUQuad then begin
|
|
if lt in [cgWord,cgUWord,cgLong,cgULong] then
|
|
Gen2(pc_cnn, ord(lt), ord(cgUQuad));
|
|
UsualBinaryConversions := cgUQuad;
|
|
expressionType := uLongLongPtr;
|
|
end {else if}
|
|
else if lt = cgQuad then begin
|
|
if rt in [cgWord,cgUWord,cgLong,cgULong] then
|
|
Gen2(pc_cnv, ord(rt), ord(cgQuad));
|
|
UsualBinaryConversions := cgQuad;
|
|
expressionType := longLongPtr;
|
|
end {else if}
|
|
else if rt = cgQuad then begin
|
|
if lt in [cgWord,cgUWord,cgLong,cgULong] then
|
|
Gen2(pc_cnn, ord(lt), ord(cgQuad));
|
|
UsualBinaryConversions := cgQuad;
|
|
expressionType := longLongPtr;
|
|
end {else if}
|
|
else if lt = cgULong then begin
|
|
if rt in [cgWord,cgUWord] then
|
|
Gen2(pc_cnv, ord(rt), ord(cgULong));
|
|
UsualBinaryConversions := cgULong;
|
|
expressionType := uLongPtr;
|
|
end {else if}
|
|
else if rt = cgULong then begin
|
|
if lt in [cgWord,cgUWord] then
|
|
Gen2(pc_cnn, ord(lt), ord(cgULong));
|
|
UsualBinaryConversions := cgULong;
|
|
expressionType := uLongPtr;
|
|
end {else if}
|
|
else if lt = cgLong then begin
|
|
if rt in [cgWord,cgUWord] then
|
|
Gen2(pc_cnv, ord(rt), ord(cgLong));
|
|
UsualBinaryConversions := cgLong;
|
|
expressionType := longPtr;
|
|
end {else if}
|
|
else if rt = cgLong then begin
|
|
if lt in [cgWord,cgUWord] then
|
|
Gen2(pc_cnn, ord(lt), ord(cgLong));
|
|
UsualBinaryConversions := cgLong;
|
|
expressionType := longPtr;
|
|
end {else if}
|
|
else {one operand is unsigned in and the other is int} begin
|
|
UsualBinaryConversions := cgUWord;
|
|
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 := intPtr;
|
|
end; {else}
|
|
end {if}
|
|
else
|
|
Error(66);
|
|
end; {UsualBinaryConversions}
|
|
|
|
|
|
function UsualUnaryConversions{: baseTypeEnum};
|
|
|
|
{ performs the usual unary conversions }
|
|
{ }
|
|
{ inputs: }
|
|
{ expressionType - type of the operand }
|
|
{ }
|
|
{ result: }
|
|
{ The base type of the operation to perform is returned. }
|
|
{ Any conversion code necessary has been generated. }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
var
|
|
et: baseTypeEnum; {work variables}
|
|
|
|
begin {UsualUnaryConversions}
|
|
UsualUnaryConversions := cgULong;
|
|
if expressionType^.kind = scalarType then begin
|
|
et := Unary(expressionType^.baseType);
|
|
UsualUnaryConversions := et;
|
|
if et = cgWord then {update types that may have changed}
|
|
expressionType := intPtr;
|
|
end {if}
|
|
{else if expressionType^.kind in [arrayType,pointerType] then
|
|
UsualUnaryConversions := cgULong};
|
|
end; {UsualUnaryConversions}
|
|
|
|
|
|
procedure DisposeTree {tree: tokenPtr};
|
|
|
|
{ dispose of an expression tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - head of the expression tree to dispose of }
|
|
|
|
begin {DisposeTree}
|
|
if tree <> nil then begin
|
|
DisposeTree(tree^.left);
|
|
DisposeTree(tree^.middle);
|
|
DisposeTree(tree^.right);
|
|
dispose(tree);
|
|
end; {if}
|
|
end; {DisposeTree}
|
|
|
|
|
|
procedure ValueExpressionConversions;
|
|
|
|
{ Perform type conversions applicable to an expression used }
|
|
{ for its value. These include lvalue conversion (removing }
|
|
{ qualifiers), array-to-pointer conversion, and }
|
|
{ function-to-pointer conversion. See C17 section 6.3.2.1. }
|
|
{ }
|
|
{ variables: }
|
|
{ expressionType - set to type after conversions }
|
|
|
|
begin {ValueExpressionConversions}
|
|
expressionType := Unqualify(expressionType);
|
|
if expressionType^.kind = arrayType then
|
|
expressionType := MakePointerTo(expressionType^.aType)
|
|
else if expressionType^.kind = functionType then
|
|
expressionType := MakePointerTo(expressionType);
|
|
end; {ValueExpressionConversions}
|
|
|
|
|
|
procedure AssignmentConversion {t1, t2: typePtr; isConstant: boolean;
|
|
value: longint; genCode, checkConst: boolean};
|
|
|
|
{ TOS is of type t2, and is about to be stored to a variable of }
|
|
{ type t1 by an assignment or a return statement. Make sure }
|
|
{ this is legal, and do any necessary type conversions on t2, }
|
|
{ which is on the top of the evaluation stack. Flag an error }
|
|
{ if the conversion is illegal. }
|
|
{ }
|
|
{ parameters: }
|
|
{ t1 - type of the variable }
|
|
{ t2 - type of the expression }
|
|
{ isConstant - is the rhs a constant? }
|
|
{ value - if isConstant = true, then this is the value }
|
|
{ genCode - should conversion code be generated? }
|
|
{ checkConst - check for assignments to constants? }
|
|
|
|
var
|
|
baseType1,baseType2: baseTypeEnum; {temp variables (for speed)}
|
|
kind1,kind2: typeKind; {temp variables (for speed)}
|
|
|
|
begin {AssignmentConversion}
|
|
kind1 := t1^.kind;
|
|
kind2 := t2^.kind;
|
|
if genCode then
|
|
if checkConst then
|
|
if kind2 <> definedType then
|
|
if tqConst in t1^.qualifiers then
|
|
Error(93)
|
|
else if kind1 in [structType,unionType] then
|
|
if t1^.constMember then
|
|
Error(93);
|
|
if kind2 = definedType then
|
|
AssignmentConversion(t1, t2^.dType, false, 0, genCode, checkConst)
|
|
else if kind1 = definedType then
|
|
AssignmentConversion(t1^.dType, t2, false, 0, genCode, checkConst)
|
|
else if kind2 in
|
|
[scalarType,pointerType,enumType,structType,unionType,arrayType,functionType] then
|
|
case kind1 of
|
|
|
|
scalarType: begin
|
|
baseType1 := t1^.baseType;
|
|
if baseType1 in [cgReal,cgDouble,cgComp] then
|
|
baseType1 := cgExtended;
|
|
if baseType1 = cgString then
|
|
Error(64)
|
|
else if baseType1 = cgVoid then
|
|
Error(65)
|
|
else if kind2 = enumType then begin
|
|
if genCode then
|
|
Gen2(pc_cnv, ord(cgWord), ord(baseType1));
|
|
end {else if}
|
|
else if kind2 = scalarType then begin
|
|
baseType2 := t2^.baseType;
|
|
if baseType2 in [cgString,cgVoid] then
|
|
Error(47)
|
|
else if genCode then begin
|
|
if t1^.cType = ctBool then begin
|
|
expressionType := t2;
|
|
CompareToZero(pc_neq);
|
|
end {if}
|
|
else
|
|
Gen2(pc_cnv, ord(baseType2), ord(baseType1));
|
|
end {else if}
|
|
end {else if}
|
|
else if (t1^.cType = ctBool)
|
|
and (kind2 in [pointerType,arrayType]) then begin
|
|
if genCode then begin
|
|
expressionType := t2;
|
|
CompareToZero(pc_neq);
|
|
end {if}
|
|
end {else if}
|
|
else
|
|
Error(47);
|
|
end;
|
|
|
|
arrayType: ;
|
|
{any errors are handled elsewhere}
|
|
|
|
functionType,enumConst:
|
|
Error(47);
|
|
|
|
pointerType: begin
|
|
if kind2 = pointerType then begin
|
|
if not CompTypes(t1, t2) then
|
|
Error(47)
|
|
else if not looseTypeChecks then
|
|
if not (t1^.ptype^.qualifiers >= t2^.ptype^.qualifiers) then
|
|
Error(163);
|
|
end {if}
|
|
else if kind2 = arrayType then begin
|
|
if not CompTypes(t1^.ptype, t2^.atype) and
|
|
(t1^.ptype^.baseType <> cgVoid) then
|
|
Error(47)
|
|
else if not looseTypeChecks then
|
|
if not (t1^.ptype^.qualifiers >= t2^.atype^.qualifiers) then
|
|
Error(163);
|
|
end {if}
|
|
else if kind2 = scalarType then begin
|
|
if isConstant and (value = 0) then begin
|
|
if genCode then
|
|
Gen2(pc_cnv, ord(t2^.baseType), ord(cgULong));
|
|
end {if}
|
|
else
|
|
Error(47);
|
|
end {else if}
|
|
else
|
|
Error(47);
|
|
end;
|
|
|
|
enumType: begin
|
|
if kind2 = scalarType then begin
|
|
baseType2 := t2^.baseType;
|
|
if baseType2 in [cgString,cgVoid] then
|
|
Error(47)
|
|
else if genCode then
|
|
Gen2(pc_cnv, ord(baseType2), ord(cgWord));
|
|
end {if}
|
|
else if kind2 <> enumType then
|
|
Error(47);
|
|
end;
|
|
|
|
definedType:
|
|
AssignmentConversion(t1^.dType, t2, isConstant, value, genCode,
|
|
checkConst);
|
|
|
|
structType,unionType:
|
|
if not CompTypes(t1, t2) then
|
|
Error(47);
|
|
|
|
otherwise: Error(57);
|
|
|
|
end; {case T1^.kind}
|
|
|
|
expressionType := t1; {set the type of the expression}
|
|
end; {AssignmentConversion}
|
|
|
|
|
|
function ExpressionTree (kind: expressionKind; stopSym: tokenSet): tokenPtr;
|
|
|
|
{ generate an expression tree }
|
|
{ }
|
|
{ Returns a pointer to the generated tree. The pointer is }
|
|
{ nil, and the variable errorFound is set to true, if an }
|
|
{ error is found. }
|
|
{ }
|
|
{ parameters: }
|
|
{ kind - Kind of expression; determines what operations }
|
|
{ and what kind of operands are allowed. }
|
|
{ stopSym - Set of symbols that can mark the end of an }
|
|
{ expression; used to skip tokens after syntax }
|
|
{ errors and to block certain operations. For }
|
|
{ example, the comma operator is not allowed in }
|
|
{ an expression when evaluating a function }
|
|
{ parameter list. }
|
|
|
|
label 1,2,3;
|
|
|
|
var
|
|
done,done2: boolean; {for loop termination}
|
|
doingSizeof: boolean; {used to test for a sizeof operator}
|
|
doingAlignof: boolean; {used to test for an _Alignof operator}
|
|
expectingTerm: boolean; {should the next token be a term?}
|
|
opStack: tokenPtr; {operation stack}
|
|
parenCount: integer; {# of open parenthesis}
|
|
stack: tokenPtr; {operand stack}
|
|
tType: typePtr; {type for cast/sizeof/etc.}
|
|
|
|
op,sp: tokenPtr; {work pointers}
|
|
|
|
|
|
procedure ComplexTerm;
|
|
|
|
{ handle complex terms }
|
|
|
|
var
|
|
done: boolean; {for loop termination}
|
|
namePtr: stringPtr; {name of struct/union fields}
|
|
sp,tp,tm: tokenPtr; {work pointers}
|
|
|
|
begin {ComplexTerm}
|
|
while token.kind in
|
|
[lbrackch,lparench,dotch,minusgtop,plusplusop,minusminusop] do begin
|
|
case token.kind of
|
|
|
|
lbrackch: begin {subscripting}
|
|
NextToken; {skip the '['}
|
|
new(sp); {evaluate the subscript}
|
|
sp^.token.kind := plusch;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := stack;
|
|
stack := stack^.next;
|
|
sp^.middle := nil;
|
|
sp^.right := ExpressionTree(normalExpression, [rbrackch]);
|
|
sp^.next := stack;
|
|
stack := sp;
|
|
Match(rbrackch,24); {skip the ']'}
|
|
new(sp); {resolve the pointer}
|
|
sp^.token.kind := uasterisk;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := stack;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.next := stack^.next;
|
|
stack := sp;
|
|
end;
|
|
|
|
lparench: begin {function call}
|
|
NextToken;
|
|
new(sp); {create a parameter list terminator}
|
|
sp^.token.kind := parameteroper;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := nil;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.next := stack;
|
|
stack := sp;
|
|
if token.kind <> rparench {evaluate the parameters}
|
|
then begin
|
|
done := false;
|
|
repeat
|
|
if token.kind in [rparench,eofsy] then begin
|
|
done := true;
|
|
Error(35);
|
|
end {if}
|
|
else begin
|
|
new(sp);
|
|
sp^.token.kind := parameteroper;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := nil;
|
|
sp^.middle :=
|
|
ExpressionTree(normalExpression, [rparench,commach]);
|
|
sp^.right := stack;
|
|
sp^.next := stack^.next;
|
|
stack := sp;
|
|
if token.kind = commach then
|
|
NextToken
|
|
else
|
|
done := true;
|
|
end; {else}
|
|
until done;
|
|
end; {if}
|
|
sp := stack;
|
|
stack := sp^.next;
|
|
sp^.left := stack;
|
|
sp^.next := stack^.next;
|
|
stack := sp;
|
|
Match(rparench,12);
|
|
end;
|
|
|
|
dotch,minusgtop: begin {direct and indirect selection}
|
|
if token.kind = minusgtop then begin
|
|
new(sp); {e->name == (*e).name}
|
|
sp^.token.kind := uasterisk;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := stack;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.next := stack^.next;
|
|
stack := sp;
|
|
token.kind := dotch;
|
|
token.class := reservedSymbol;
|
|
end; {if}
|
|
new(sp); {create a record for the selection operator}
|
|
sp^.token := token;
|
|
sp^.left := stack;
|
|
stack := stack^.next;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.next := stack;
|
|
stack := sp;
|
|
NextToken; {skip the operator}
|
|
if token.kind in [ident,typedef] then begin
|
|
namePtr := token.name; {record the name}
|
|
new(sp); {record the selection field}
|
|
sp^.token := token;
|
|
sp^.left := nil;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
stack^.right := sp; {this becomes the right opnd}
|
|
NextToken; {skip the field name}
|
|
end {if}
|
|
else
|
|
Error(9);
|
|
end;
|
|
|
|
plusplusop: begin {postfix ++}
|
|
NextToken;
|
|
new(sp);
|
|
sp^.token.kind := opplusplus;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := stack;
|
|
stack := stack^.next;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.next := stack;
|
|
stack := sp;
|
|
end;
|
|
|
|
minusminusop: begin {postfix --}
|
|
NextToken;
|
|
new(sp);
|
|
sp^.token.kind := opminusminus;
|
|
sp^.token.class := reservedSymbol;
|
|
sp^.left := stack;
|
|
stack := stack^.next;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.next := stack;
|
|
stack := sp;
|
|
end;
|
|
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
end; {while}
|
|
end; {ComplexTerm}
|
|
|
|
|
|
procedure DoOperand;
|
|
|
|
{ process an operand }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
fnPtr: typePtr; {for defining functions on the fly}
|
|
fToken: tokenType; {used to save function name token}
|
|
id: identPtr; {pointer to an id's symbol table entry}
|
|
np: stringPtr; {for forming global names}
|
|
sp: tokenPtr; {work pointer}
|
|
|
|
begin {DoOperand}
|
|
{create an operand on the stack}
|
|
new(sp);
|
|
sp^.token := token;
|
|
sp^.next := stack;
|
|
sp^.left := nil;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
stack := sp;
|
|
|
|
{handle the preprocessor 'defined' function}
|
|
if kind = preprocessorExpression then
|
|
if token.name^ = 'defined' then begin
|
|
expandMacros := false;
|
|
NextToken;
|
|
sp^.token.kind := intconst;
|
|
sp^.token.class := intConstant;
|
|
if token.kind in [ident,typedef] then begin
|
|
sp^.token.ival := ord(IsDefined(token.name));
|
|
NextToken;
|
|
end {if}
|
|
else begin
|
|
Match(lparench, 13);
|
|
if token.kind in [ident,typedef] then begin
|
|
sp^.token.ival := ord(IsDefined(token.name));
|
|
NextToken;
|
|
end {if}
|
|
else begin
|
|
Error(9);
|
|
sp^.token.ival := 0;
|
|
end; {else}
|
|
Match(rparench, 12);
|
|
end; {else}
|
|
expandMacros := true;
|
|
goto 1;
|
|
end; {if}
|
|
|
|
{check for illegal use}
|
|
id := FindSymbol(token, variableSpace, false, true);
|
|
if not (kind in
|
|
[normalExpression,initializerExpression,autoInitializerExpression])
|
|
then begin
|
|
if id <> nil then
|
|
if id^.itype^.kind = enumConst then
|
|
goto 2;
|
|
if kind <> preprocessorExpression then begin
|
|
op := opStack;
|
|
while op <> nil do begin
|
|
if op^.token.kind = sizeofsy then
|
|
goto 2;
|
|
op := op^.next;
|
|
end; {while}
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {if}
|
|
end; {if}
|
|
2:
|
|
{skip the name}
|
|
fToken := token;
|
|
NextToken;
|
|
|
|
{in the preprocessor, all identifiers (post macro replacement) become 0}
|
|
if kind = preprocessorExpression then begin
|
|
stack^.token.class := longlongConstant;
|
|
stack^.token.kind := longlongconst;
|
|
stack^.token.qval := longlong0;
|
|
end {if}
|
|
|
|
{if the id is not declared, create a function returning integer}
|
|
else if id = nil then begin
|
|
if (fToken.name^ = '__func__') and (functionTable <> nil) then
|
|
id := MakeFuncIdentifier
|
|
else if token.kind = lparench then begin
|
|
fnPtr := pointer(GCalloc(sizeof(typeRecord)));
|
|
{fnPtr^.size := 0;}
|
|
{fnPtr^.saveDisp := 0;}
|
|
{fnPtr^.qualifiers := [];}
|
|
fnPtr^.kind := functionType;
|
|
fnPtr^.fType := intPtr;
|
|
{fnPtr^.varargs := false;}
|
|
{fnPtr^.prototyped := false;}
|
|
{fnPtr^.overrideKR := false;}
|
|
{fnPtr^.parameterList := nil;}
|
|
{fnPtr^.isPascal := false;}
|
|
{fnPtr^.toolNum := 0;}
|
|
{fnPtr^.dispatcher := 0;}
|
|
np := pointer(GMalloc(length(fToken.name^)+1));
|
|
CopyString(pointer(np), pointer(fToken.name));
|
|
id := NewSymbol(np, fnPtr, ident, variableSpace, declared);
|
|
if ((lint & lintUndefFn) <> 0) or ((lint & lintC99Syntax) <> 0) then
|
|
Error(51);
|
|
end {if}
|
|
else begin
|
|
Error(31);
|
|
errorFound := true;
|
|
end; {else}
|
|
end {if id = nil}
|
|
else if id^.itype^.kind = enumConst then begin
|
|
stack^.token.class := intConstant;
|
|
stack^.token.kind := intconst;
|
|
stack^.token.ival := id^.itype^.eval;
|
|
end; {else if}
|
|
stack^.id := id; {save the identifier}
|
|
ComplexTerm; {handle subscripts, selection, etc.}
|
|
1:
|
|
end; {DoOperand}
|
|
|
|
|
|
procedure Operation;
|
|
|
|
{ do an operation }
|
|
|
|
label 1,2,3,4;
|
|
|
|
var
|
|
baseType: baseTypeEnum; {base type of value to cast}
|
|
class: tokenClass; {class of cast token}
|
|
ekind: tokenEnum; {kind of constant expression}
|
|
kindLeft, kindRight: tokenEnum; {kinds of operands}
|
|
lCodeGeneration: boolean; {local copy of codeGeneration}
|
|
op: tokenPtr; {work pointer}
|
|
op1,op2: longint; {for evaluating constant expressions}
|
|
rop1,rop2: extended; {for evaluating fp expressions}
|
|
llop1, llop2: longlong; {for evaluating long long expressions}
|
|
tp: typePtr; {cast type}
|
|
unsigned: boolean; {is the term unsigned?}
|
|
|
|
|
|
function Pop: tokenPtr;
|
|
|
|
{ pop an operand, returning its pointer }
|
|
|
|
begin {Pop}
|
|
if stack = nil then begin
|
|
Error(36);
|
|
errorFound := true;
|
|
new(stack); {synthesize the missing token}
|
|
stack^.token.class := intConstant;
|
|
stack^.token.kind := intconst;
|
|
stack^.token.ival := 0;
|
|
stack^.next := nil;
|
|
stack^.left := nil;
|
|
stack^.middle := nil;
|
|
stack^.right := nil;
|
|
end; {if}
|
|
Pop := stack;
|
|
stack := stack^.next;
|
|
end; {Pop}
|
|
|
|
|
|
function RealVal (token: tokenType): extended;
|
|
|
|
{ convert an operand to a real value }
|
|
|
|
begin {RealVal}
|
|
if token.kind in [intconst,charconst,scharconst,ucharconst] then
|
|
RealVal := token.ival
|
|
else if token.kind in [uintconst,ushortconst] then begin
|
|
if token.ival < 0 then
|
|
RealVal := (token.ival & $7FFF) + 32768.0
|
|
else
|
|
RealVal := token.ival;
|
|
end {else if}
|
|
else if token.kind = longconst then
|
|
RealVal := token.lval
|
|
else if token.kind = ulongconst then begin
|
|
if token.lval < 0 then
|
|
RealVal := (token.lval & $7FFFFFFF) + 2147483648.0
|
|
else
|
|
RealVal := token.lval;
|
|
end {else if}
|
|
else if token.kind = longlongconst then
|
|
RealVal := CnvLLX(token.qval)
|
|
else if token.kind = ulonglongconst then
|
|
RealVal := CnvULLX(token.qval)
|
|
else
|
|
RealVal := token.rval;
|
|
end; {RealVal}
|
|
|
|
|
|
function IntVal (token: tokenType): longint;
|
|
|
|
{ convert an operand to a longint value }
|
|
|
|
begin {IntVal}
|
|
if token.kind in [intconst,charconst,scharconst,ucharconst] then
|
|
IntVal := token.ival
|
|
else if token.kind in [uintconst,ushortconst] then begin
|
|
IntVal := token.ival & $0000FFFF;
|
|
end {else if}
|
|
else {if token.kind in [longconst,ulongconst] then} begin
|
|
IntVal := token.lval;
|
|
end; {else}
|
|
end; {IntVal}
|
|
|
|
|
|
procedure GetLongLongVal (var result: longlong; token: tokenType);
|
|
|
|
{ convert an operand to a long long value }
|
|
|
|
begin {LongLongVal}
|
|
if token.kind in [intconst,charconst,scharconst,ucharconst] then begin
|
|
result.lo := token.ival;
|
|
if result.lo < 0 then
|
|
result.hi := -1
|
|
else
|
|
result.hi := 0;
|
|
end {if}
|
|
else if token.kind in [uintconst,ushortconst] then begin
|
|
result.lo := token.ival & $0000FFFF;
|
|
result.hi := 0;
|
|
end {else if}
|
|
else if token.kind = longconst then begin
|
|
result.lo := token.lval;
|
|
if result.lo < 0 then
|
|
result.hi := -1
|
|
else
|
|
result.hi := 0;
|
|
end {else if}
|
|
else if token.kind = ulongconst then begin
|
|
result.lo := token.lval;
|
|
result.hi := 0;
|
|
end {else if}
|
|
else {if token.kind in [longlongconst,ulonglongconst] then} begin
|
|
result := token.qval;
|
|
end; {else}
|
|
end; {LongLongVal}
|
|
|
|
|
|
function PPKind (token: tokenType): tokenEnum;
|
|
|
|
{ adjust kind of token for use in preprocessor expression }
|
|
|
|
begin {PPKind}
|
|
if token.kind in [intconst,longconst] then
|
|
PPKind := longlongconst
|
|
else if token.kind in [uintconst,ushortconst,ulongconst] then
|
|
PPKind := ulonglongconst
|
|
else
|
|
PPKind := token.kind;
|
|
end; {PPKind}
|
|
|
|
|
|
begin {Operation}
|
|
op := opStack; {pop the operation}
|
|
opStack := op^.next;
|
|
case op^.token.kind of
|
|
|
|
commach: begin {,}
|
|
op^.right := Pop;
|
|
op^.left := Pop;
|
|
end;
|
|
|
|
eqch, {=}
|
|
pluseqop, {+=}
|
|
minuseqop, {-=}
|
|
asteriskeqop, {*=}
|
|
slasheqop, {/=}
|
|
percenteqop, {%=}
|
|
ltlteqop, {<<=}
|
|
gtgteqop, {>>=}
|
|
andeqop, {&=}
|
|
caroteqop, {^=}
|
|
bareqop: begin {|=}
|
|
op^.right := Pop;
|
|
op^.left := Pop;
|
|
end;
|
|
|
|
colonch: begin {? :}
|
|
op^.right := Pop;
|
|
op^.middle := Pop;
|
|
op^.left := Pop;
|
|
if op^.right^.token.kind in [intconst,uintconst,ushortconst,
|
|
longconst,ulongconst,longlongconst,ulonglongconst,
|
|
charconst,scharconst,ucharconst] then
|
|
if op^.left^.token.kind in [intconst,uintconst,ushortconst,
|
|
longconst,ulongconst,longlongconst,ulonglongconst,
|
|
charconst,scharconst,ucharconst] then
|
|
if op^.middle^.token.kind in [intconst,uintconst,ushortconst,
|
|
longconst,ulongconst,longlongconst,ulonglongconst,
|
|
charconst,scharconst,ucharconst] then begin
|
|
|
|
kindLeft := op^.middle^.token.kind;
|
|
kindRight := op^.right^.token.kind;
|
|
|
|
{do the usual binary conversions}
|
|
if (kindRight = ulonglongconst) or (kindLeft = ulonglongconst) then
|
|
ekind := ulonglongconst
|
|
else if (kindRight = longlongconst) or (kindLeft = longlongconst) then
|
|
ekind := longlongconst
|
|
else if (kindRight = ulongconst) or (kindLeft = ulongconst) then
|
|
ekind := ulongconst
|
|
else if (kindRight = longconst) or (kindLeft = longconst) then
|
|
ekind := longconst
|
|
else if (kindRight = uintconst) or (kindLeft = uintconst)
|
|
or (kindRight = ushortconst) or (kindLeft = ushortconst) then
|
|
ekind := uintconst
|
|
else
|
|
ekind := intconst;
|
|
|
|
GetLongLongVal(llop1, op^.left^.token);
|
|
if (llop1.lo <> 0) or (llop1.hi <> 0) then
|
|
GetLongLongVal(llop2, op^.middle^.token)
|
|
else
|
|
GetLongLongVal(llop2, op^.right^.token);
|
|
op^.token.kind := ekind;
|
|
if ekind in [longlongconst,ulonglongconst] then begin
|
|
op^.token.qval := llop2;
|
|
op^.token.class := longlongConstant;
|
|
end {if}
|
|
else if ekind in [longconst,ulongconst] then begin
|
|
op^.token.lval := llop2.lo;
|
|
op^.token.class := longConstant;
|
|
end {if}
|
|
else begin
|
|
op^.token.ival := long(llop2.lo).lsw;
|
|
op^.token.class := intConstant;
|
|
end; {else}
|
|
|
|
dispose(op^.left);
|
|
dispose(op^.right);
|
|
dispose(op^.middle);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
op^.middle := nil;
|
|
end; {if}
|
|
end;
|
|
|
|
questionch: begin {error -> ? should not be unmatched}
|
|
Error(29);
|
|
errorFound := true;
|
|
end;
|
|
|
|
barbarop, {||}
|
|
andandop, {&&}
|
|
carotch, {^}
|
|
barch, {|}
|
|
andch, {&}
|
|
eqeqop, {==}
|
|
exceqop, {!=}
|
|
ltch, {<}
|
|
gtch, {>}
|
|
lteqop, {<=}
|
|
gteqop, {>=}
|
|
ltltop, {<<}
|
|
gtgtop, {>>}
|
|
plusch, {+}
|
|
minusch, {-}
|
|
asteriskch, {*}
|
|
slashch, {/}
|
|
percentch: begin {%}
|
|
op^.right := Pop;
|
|
op^.left := Pop;
|
|
kindRight := op^.right^.token.kind;
|
|
kindLeft := op^.left^.token.kind;
|
|
if kindRight in [intconst,uintconst,ushortconst,longconst,ulongconst,
|
|
charconst,scharconst,ucharconst] then begin
|
|
if kindLeft in [intconst,uintconst,ushortconst,longconst,ulongconst,
|
|
charconst,scharconst,ucharconst] then begin
|
|
if kind = preprocessorExpression then
|
|
goto 2;
|
|
|
|
{do the usual binary conversions}
|
|
if (kindRight = ulongconst) or (kindLeft = ulongconst) then
|
|
ekind := ulongconst
|
|
else if (kindRight = longconst) or (kindLeft = longconst) then
|
|
ekind := longconst
|
|
else if (kindRight = uintconst) or (kindLeft = uintconst)
|
|
or (kindRight = ushortconst) or (kindLeft = ushortconst) then
|
|
ekind := uintconst
|
|
else
|
|
ekind := intconst;
|
|
|
|
{evaluate a constant operation}
|
|
unsigned := ekind in [uintconst,ulongconst];
|
|
op1 := IntVal(op^.left^.token);
|
|
op2 := IntVal(op^.right^.token);
|
|
dispose(op^.right);
|
|
op^.right := nil;
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
case op^.token.kind of
|
|
barbarop : begin {||}
|
|
op1 := ord((op1 <> 0) or (op2 <> 0));
|
|
ekind := intconst;
|
|
end;
|
|
andandop : begin {&&}
|
|
op1 := ord((op1 <> 0) and (op2 <> 0));
|
|
ekind := intconst;
|
|
end;
|
|
carotch : op1 := op1 ! op2; {^}
|
|
barch : op1 := op1 | op2; {|}
|
|
andch : op1 := op1 & op2; {&}
|
|
eqeqop : begin {==}
|
|
op1 := ord(op1 = op2);
|
|
ekind := intconst;
|
|
end;
|
|
exceqop : begin {!=}
|
|
op1 := ord(op1 <> op2);
|
|
ekind := intconst;
|
|
end;
|
|
ltch : begin {<}
|
|
if unsigned then
|
|
op1 := ult(op1,op2)
|
|
else
|
|
op1 := ord(op1 < op2);
|
|
ekind := intconst;
|
|
end;
|
|
gtch : begin {>}
|
|
if unsigned then
|
|
op1 := ugt(op1,op2)
|
|
else
|
|
op1 := ord(op1 > op2);
|
|
ekind := intconst;
|
|
end;
|
|
lteqop : begin {<=}
|
|
if unsigned then
|
|
op1 := ule(op1,op2)
|
|
else
|
|
op1 := ord(op1 <= op2);
|
|
ekind := intconst;
|
|
end;
|
|
gteqop : begin {>=}
|
|
if unsigned then
|
|
op1 := uge(op1,op2)
|
|
else
|
|
op1 := ord(op1 >= op2);
|
|
ekind := intconst;
|
|
end;
|
|
ltltop : begin {<<}
|
|
op1 := op1 << op2;
|
|
ekind := kindLeft;
|
|
end;
|
|
gtgtop : begin {>>}
|
|
if kindLeft in [uintconst,ushortconst,ulongconst]
|
|
then
|
|
op1 := lshr(op1,op2)
|
|
else
|
|
op1 := op1 >> op2;
|
|
ekind := kindLeft;
|
|
end;
|
|
plusch : op1 := op1 + op2; {+}
|
|
minusch : op1 := op1 - op2; {-}
|
|
asteriskch : if unsigned then {*}
|
|
op1 := umul(op1,op2)
|
|
else
|
|
op1 := op1 * op2;
|
|
slashch : begin {/}
|
|
if op2 = 0 then begin
|
|
Error(109);
|
|
op2 := 1;
|
|
end; {if}
|
|
if unsigned then
|
|
op1 := udiv(op1,op2)
|
|
else
|
|
op1 := op1 div op2;
|
|
end;
|
|
percentch : begin {%}
|
|
if op2 = 0 then begin
|
|
Error(109);
|
|
op2 := 1;
|
|
end; {if}
|
|
if unsigned then
|
|
op1 := umod(op1,op2)
|
|
else
|
|
op1 := op1 - (op1 div op2) * op2;
|
|
end;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
if ((lint & lintOverflow) <> 0) then begin
|
|
if op^.token.kind in [plusch,minusch,asteriskch,slashch] then
|
|
if ekind = intConst then
|
|
if op1 <> long(op1).lsw then
|
|
Error(128);
|
|
if op^.token.kind in [ltltop,gtgtop] then begin
|
|
if ekind in [intConst,uintConst] then
|
|
if (op2 < 0) or (op2 > 15) then
|
|
Error(130);
|
|
if ekind in [longConst,ulongConst] then
|
|
if (op2 < 0) or (op2 > 31) then
|
|
Error(130);
|
|
end; {if}
|
|
end; {if}
|
|
op^.token.kind := ekind;
|
|
if ekind in [longconst,ulongconst] then begin
|
|
op^.token.lval := op1;
|
|
op^.token.class := longConstant;
|
|
end {if}
|
|
else begin
|
|
op^.token.ival := long(op1).lsw;
|
|
op^.token.class := intConstant;
|
|
end; {else}
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
2:
|
|
if kindRight in [intconst,uintconst,ushortconst,longconst,ulongconst,
|
|
longlongconst,ulonglongconst,charconst,scharconst,ucharconst]
|
|
then begin
|
|
if kindLeft in [intconst,uintconst,ushortconst,longconst,ulongconst,
|
|
longlongconst,ulonglongconst,charconst,scharconst,ucharconst]
|
|
then begin
|
|
|
|
if kind = preprocessorExpression then begin
|
|
kindLeft := PPKind(op^.left^.token);
|
|
kindRight := PPKind(op^.right^.token);
|
|
end; {if}
|
|
|
|
{do the usual binary conversions}
|
|
if (kindRight = ulonglongconst) or (kindLeft = ulonglongconst) then
|
|
ekind := ulonglongconst
|
|
else
|
|
ekind := longlongconst;
|
|
|
|
unsigned := ekind = ulonglongconst;
|
|
GetLongLongVal(llop1, op^.left^.token);
|
|
GetLongLongVal(llop2, op^.right^.token);
|
|
|
|
case op^.token.kind of
|
|
barbarop : begin {||}
|
|
llop1.lo :=
|
|
ord((llop1.lo <> 0) or (llop1.hi <> 0) or
|
|
(llop2.lo <> 0) or (llop2.hi <> 0));
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
andandop : begin {&&}
|
|
llop1.lo :=
|
|
ord(((llop1.lo <> 0) or (llop1.hi <> 0)) and
|
|
((llop2.lo <> 0) or (llop2.hi <> 0)));
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
carotch : begin {^}
|
|
llop1.lo := llop1.lo ! llop2.lo;
|
|
llop1.hi := llop1.hi ! llop2.hi;
|
|
end;
|
|
barch : begin {|}
|
|
llop1.lo := llop1.lo | llop2.lo;
|
|
llop1.hi := llop1.hi | llop2.hi;
|
|
end;
|
|
andch : begin {&}
|
|
llop1.lo := llop1.lo & llop2.lo;
|
|
llop1.hi := llop1.hi & llop2.hi;
|
|
end;
|
|
eqeqop : begin {==}
|
|
llop1.lo := ord((llop1.lo = llop2.lo) and
|
|
(llop1.hi = llop2.hi));
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
exceqop : begin {!=}
|
|
llop1.lo := ord((llop1.lo <> llop2.lo) or
|
|
(llop1.hi <> llop2.hi));
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
ltch : begin {<}
|
|
if unsigned then
|
|
llop1.lo := ult64(llop1, llop2)
|
|
else
|
|
llop1.lo := slt64(llop1, llop2);
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
gtch : begin {>}
|
|
if unsigned then
|
|
llop1.lo := ugt64(llop1, llop2)
|
|
else
|
|
llop1.lo := sgt64(llop1, llop2);
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
lteqop : begin {<=}
|
|
if unsigned then
|
|
llop1.lo := ule64(llop1, llop2)
|
|
else
|
|
llop1.lo := sle64(llop1, llop2);
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
gteqop : begin {>=}
|
|
if unsigned then
|
|
llop1.lo := uge64(llop1, llop2)
|
|
else
|
|
llop1.lo := sge64(llop1, llop2);
|
|
llop1.hi := 0;
|
|
ekind := intconst;
|
|
end;
|
|
ltltop : begin {<<}
|
|
shl64(llop1, long(llop2.lo).lsw);
|
|
ekind := kindLeft;
|
|
end;
|
|
gtgtop : begin {>>}
|
|
if kindleft = ulonglongconst then
|
|
lshr64(llop1, long(llop2.lo).lsw)
|
|
else
|
|
ashr64(llop1, long(llop2.lo).lsw);
|
|
ekind := kindLeft;
|
|
end;
|
|
plusch : add64(llop1, llop2); {+}
|
|
minusch : sub64(llop1, llop2); {-}
|
|
asteriskch : umul64(llop1, llop2); {*}
|
|
slashch : begin {/}
|
|
if (llop2.lo = 0) and (llop2.hi = 0) then begin
|
|
Error(109);
|
|
llop2 := longlong1;
|
|
end; {if}
|
|
if unsigned then
|
|
udiv64(llop1, llop2)
|
|
else
|
|
div64(llop1, llop2);
|
|
end;
|
|
percentch : begin {%}
|
|
if (llop2.lo = 0) and (llop2.hi = 0) then begin
|
|
Error(109);
|
|
llop2 := longlong1;
|
|
end; {if}
|
|
if unsigned then
|
|
umod64(llop1, llop2)
|
|
else
|
|
rem64(llop1, llop2);
|
|
end;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
|
|
dispose(op^.right);
|
|
op^.right := nil;
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
op^.token.kind := ekind;
|
|
if ekind in [longlongconst,ulonglongconst] then begin
|
|
op^.token.qval := llop1;
|
|
op^.token.class := longlongConstant;
|
|
end {if}
|
|
else if ekind in [longconst,ulongconst] then begin
|
|
op^.token.lval := llop1.lo;
|
|
op^.token.class := longConstant;
|
|
end {if}
|
|
else begin
|
|
op^.token.ival := long(llop1.lo).lsw;
|
|
op^.token.class := intConstant;
|
|
end; {else}
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
|
|
if op^.right^.token.kind in [intconst,uintconst,longconst,ulongconst,
|
|
longlongconst,ulonglongconst,floatconst,doubleconst,extendedconst,
|
|
compconst,charconst,scharconst,ucharconst,ushortconst] then
|
|
if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,
|
|
longlongconst,ulonglongconst,floatconst,doubleconst,extendedconst,
|
|
compconst,charconst,scharconst,ucharconst,ushortconst] then
|
|
begin
|
|
if fenvAccess then
|
|
if kind in [normalExpression, autoInitializerExpression] then
|
|
goto 1;
|
|
if (op^.right^.token.kind = compConst)
|
|
and (op^.left^.token.kind = compConst) then
|
|
ekind := compconst
|
|
else if (op^.right^.token.kind in [extendedConst,compConst])
|
|
or (op^.left^.token.kind in [extendedConst,compConst]) then
|
|
ekind := extendedconst
|
|
else if (op^.right^.token.kind = doubleConst)
|
|
or (op^.left^.token.kind = doubleConst) then
|
|
ekind := doubleconst
|
|
else
|
|
ekind := floatconst;
|
|
rop1 := RealVal(op^.left^.token);
|
|
rop2 := RealVal(op^.right^.token);
|
|
dispose(op^.right);
|
|
op^.right := nil;
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
case op^.token.kind of
|
|
barbarop : begin {||}
|
|
op1 := ord((rop1 <> 0.0) or (rop2 <> 0.0));
|
|
ekind := intconst;
|
|
end;
|
|
andandop : begin {&&}
|
|
op1 := ord((rop1 <> 0.0) and (rop2 <> 0.0));
|
|
ekind := intconst;
|
|
end;
|
|
eqeqop : begin {==}
|
|
op1 := ord(rop1 = rop2);
|
|
ekind := intconst;
|
|
end;
|
|
exceqop : begin {!=}
|
|
op1 := ord(rop1 <> rop2);
|
|
ekind := intconst;
|
|
end;
|
|
ltch : begin {<}
|
|
op1 := ord(rop1 < rop2);
|
|
ekind := intconst;
|
|
end;
|
|
gtch : begin {>}
|
|
op1 := ord(rop1 > rop2);
|
|
ekind := intconst;
|
|
end;
|
|
lteqop : begin {<=}
|
|
op1 := ord(rop1 <= rop2);
|
|
ekind := intconst;
|
|
end;
|
|
gteqop : begin {>=}
|
|
op1 := ord(rop1 >= rop2);
|
|
ekind := intconst;
|
|
end;
|
|
plusch : rop1 := rop1 + rop2; {+}
|
|
minusch : rop1 := rop1 - rop2; {-}
|
|
asteriskch : rop1 := rop1 * rop2; {*}
|
|
slashch : rop1 := rop1 / rop2; {/}
|
|
|
|
otherwise : Error(66); {illegal operation}
|
|
end; {case}
|
|
if ekind = intconst then begin
|
|
op^.token.ival := long(op1).lsw;
|
|
op^.token.class := intConstant;
|
|
op^.token.kind := intConst;
|
|
end {if}
|
|
else begin
|
|
op^.token.rval := rop1;
|
|
op^.token.class := realConstant;
|
|
op^.token.kind := ekind;
|
|
end; {else}
|
|
end; {if}
|
|
1:
|
|
end;
|
|
|
|
plusplusop, {prefix ++}
|
|
minusminusop, {prefix --}
|
|
opplusplus, {postfix ++}
|
|
opminusminus, {postfix --}
|
|
sizeofsy, {sizeof}
|
|
_Alignofsy, {_Alignof (erroneous uses)}
|
|
castoper, {(type)}
|
|
typedef, {(type-name)}
|
|
tildech, {~}
|
|
excch, {!}
|
|
uminus, {unary -}
|
|
uand, {unary &}
|
|
uasterisk: begin {unary *}
|
|
op^.left := Pop;
|
|
|
|
if op^.token.kind = sizeofsy then begin
|
|
op^.token.kind := ulongConst;
|
|
op^.token.class := longConstant;
|
|
if op^.left^.token.kind = stringConst then
|
|
op^.token.lval := op^.left^.token.sval^.length
|
|
else begin
|
|
lCodeGeneration := codeGeneration;
|
|
codeGeneration := false;
|
|
GenerateCode(op^.left);
|
|
codeGeneration := lCodeGeneration and (numErrors = 0);
|
|
op^.token.lval := expressionType^.size;
|
|
with expressionType^ do
|
|
if (size = 0) or ((kind = arrayType) and (elements = 0)) then
|
|
Error(49);
|
|
end; {else}
|
|
op^.left := nil;
|
|
end {if sizeofsy}
|
|
|
|
else if op^.token.kind = _Alignofsy then begin
|
|
{error case: operand of _Alignof is not a parenthesized type-name}
|
|
Error(36);
|
|
op^.token.kind := ulongConst;
|
|
op^.token.class := longConstant;
|
|
op^.token.lval := 1;
|
|
dispose(op^.left);
|
|
end {else if _Alignofsy}
|
|
|
|
else if op^.token.kind = castoper then begin
|
|
class := op^.left^.token.class;
|
|
if class in [intConstant,longConstant,longlongconstant,
|
|
realConstant] then begin
|
|
tp := op^.castType;
|
|
while tp^.kind = definedType do
|
|
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
|
|
rop1 := RealVal(op^.left^.token);
|
|
if baseType = cgUQuad then
|
|
CnvXULL(llop1, rop1)
|
|
else
|
|
CnvXLL(llop1, rop1);
|
|
end {if}
|
|
else begin {handle integer constants}
|
|
GetLongLongVal(llop1, op^.left^.token);
|
|
if op^.left^.token.kind = ulonglongconst then
|
|
rop1 := CnvULLX(llop1)
|
|
else
|
|
rop1 := CnvLLX(llop1);
|
|
end; {else if}
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
if baseType in [cgByte,cgWord] then begin
|
|
if baseType = cgByte then
|
|
op^.token.kind := scharConst
|
|
else
|
|
op^.token.kind := intConst;
|
|
op^.token.class := intConstant;
|
|
if tp^.cType = ctBool then
|
|
op^.token.ival := ord(rop1 <> 0.0)
|
|
else
|
|
op^.token.ival := long(llop1.lo).lsw;
|
|
if baseType = cgByte then
|
|
with op^.token do begin
|
|
ival := ival & $00FF;
|
|
if (ival & $0080) <> 0 then
|
|
ival := ival | $FF00;
|
|
end; {with}
|
|
end {if}
|
|
else if baseType = cgUWord then begin
|
|
op^.token.kind := uintConst;
|
|
op^.token.class := intConstant;
|
|
op^.token.ival := long(llop1.lo).lsw;
|
|
end {else if}
|
|
else if baseType = cgUByte then begin
|
|
if tp^.cType = ctUChar then
|
|
op^.token.kind := ucharConst
|
|
else
|
|
op^.token.kind := charConst;
|
|
op^.token.class := intConstant;
|
|
op^.token.ival := long(llop1.lo).lsw;
|
|
op^.token.ival := op^.token.ival & $00FF;
|
|
end {else if}
|
|
else if baseType = cgLong then begin
|
|
op^.token.kind := longConst;
|
|
op^.token.class := longConstant;
|
|
op^.token.lval := llop1.lo;
|
|
end {else if}
|
|
else if baseType = cgULong then begin
|
|
op^.token.kind := ulongConst;
|
|
op^.token.class := longConstant;
|
|
op^.token.lval := llop1.lo;
|
|
end {else if}
|
|
else if baseType = cgQuad then begin
|
|
op^.token.kind := longlongConst;
|
|
op^.token.class := longlongConstant;
|
|
op^.token.qval := llop1;
|
|
end {else if}
|
|
else if baseType = cgUQuad then begin
|
|
op^.token.kind := ulonglongConst;
|
|
op^.token.class := longlongConstant;
|
|
op^.token.qval := llop1;
|
|
end {else if}
|
|
else begin
|
|
case baseType of
|
|
cgReal: op^.token.kind := floatConst;
|
|
cgDouble: op^.token.kind := doubleConst;
|
|
cgExtended: op^.token.kind := extendedConst;
|
|
cgComp: op^.token.kind := compConst;
|
|
end; {case}
|
|
op^.token.class := realConstant;
|
|
LimitPrecision(rop1, baseType);
|
|
op^.token.rval := rop1;
|
|
end; {else if}
|
|
end; {if}
|
|
3: end; {if}
|
|
end; {if}
|
|
end {else if castoper}
|
|
|
|
else if not (op^.token.kind in
|
|
[typedef,plusplusop,minusminusop,opplusplus,opminusminus,uand]) then
|
|
begin
|
|
if (kind <> preprocessorExpression) and (op^.left^.token.kind
|
|
in [intconst,uintconst,longconst,ulongconst,charconst,scharconst,
|
|
ucharconst,ushortconst]) then begin
|
|
|
|
{evaluate a constant operation}
|
|
ekind := op^.left^.token.kind;
|
|
if ekind in [charconst,scharconst,ucharconst] then
|
|
ekind := intconst;
|
|
op1 := IntVal(op^.left^.token);
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
case op^.token.kind of
|
|
tildech : op1 := ~op1; {~}
|
|
excch : begin {!}
|
|
op1 := ord(op1 = 0);
|
|
ekind := intconst;
|
|
end;
|
|
uminus : op1 := -op1; {unary -}
|
|
uasterisk : Error(79); {unary *}
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
op^.token.kind := ekind;
|
|
if ekind in [longconst,ulongconst] then begin
|
|
op^.token.class := longConstant;
|
|
op^.token.lval := op1;
|
|
end {if}
|
|
else begin
|
|
op^.token.class := intConstant;
|
|
op^.token.ival := long(op1).lsw;
|
|
end; {else}
|
|
end {if}
|
|
else if op^.left^.token.kind in [longlongconst,ulonglongconst,
|
|
intconst,uintconst,longconst,ulongconst,charconst,scharconst,
|
|
ucharconst,ushortconst] then begin
|
|
|
|
{evaluate a constant operation with long long operand}
|
|
ekind := op^.left^.token.kind;
|
|
if ekind in [charconst,scharconst,ucharconst] then
|
|
ekind := intconst;
|
|
if kind = preprocessorExpression then
|
|
ekind := PPKind(op^.left^.token);
|
|
GetLongLongVal(llop1, op^.left^.token);
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
case op^.token.kind of
|
|
tildech : begin {~}
|
|
llop1.lo := ~llop1.lo;
|
|
llop1.hi := ~llop1.hi;
|
|
end;
|
|
excch : begin {!}
|
|
op1 := ord((llop1.hi = 0) and (llop1.lo = 0));
|
|
ekind := intconst;
|
|
end;
|
|
uminus : begin {unary -}
|
|
llop1.lo := ~llop1.lo;
|
|
llop1.hi := ~llop1.hi;
|
|
llop1.lo := llop1.lo + 1;
|
|
if llop1.lo = 0 then
|
|
llop1.hi := llop1.hi + 1;
|
|
end;
|
|
uasterisk : Error(79); {unary *}
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
op^.token.kind := ekind;
|
|
if ekind in [longlongconst,ulonglongconst] then begin
|
|
op^.token.class := longlongConstant;
|
|
op^.token.qval := llop1;
|
|
end {if}
|
|
else begin
|
|
op^.token.class := intConstant;
|
|
op^.token.ival := long(op1).lsw;
|
|
end; {else}
|
|
end {else if}
|
|
else if op^.left^.token.kind in
|
|
[floatconst,doubleconst,extendedconst,compconst] then begin
|
|
if fenvAccess then
|
|
if kind in [normalExpression, autoInitializerExpression] then
|
|
goto 4;
|
|
ekind := op^.left^.token.kind;
|
|
rop1 := RealVal(op^.left^.token);
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
case op^.token.kind of
|
|
uminus : begin {unary -}
|
|
op^.token.class := realConstant;
|
|
op^.token.kind := ekind;
|
|
op^.token.rval := -rop1;
|
|
end;
|
|
excch : begin {!}
|
|
op^.token.class := intConstant;
|
|
op^.token.kind := intconst;
|
|
op^.token.ival := ord(rop1 = 0.0);
|
|
end;
|
|
otherwise : begin {illegal operation}
|
|
Error(66);
|
|
op^.token.class := realConstant;
|
|
op^.token.kind := ekind;
|
|
op^.token.rval := rop1;
|
|
end;
|
|
end; {case}
|
|
end; {if}
|
|
end; {if}
|
|
4:
|
|
end;
|
|
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
op^.next := stack; {place the operation on the operand stack}
|
|
stack := op;
|
|
end; {Operation}
|
|
|
|
|
|
procedure Skip;
|
|
|
|
{ skip all tokens in the remainder of the expression }
|
|
|
|
begin {Skip}
|
|
while not (token.kind in stopSym+[eofsy]) do
|
|
NextToken;
|
|
errorFound := true;
|
|
end; {Skip}
|
|
|
|
|
|
procedure DoGeneric;
|
|
|
|
{ process a generic selection expression }
|
|
|
|
label 10;
|
|
|
|
type
|
|
typeListPtr = ^typeList;
|
|
typeList = record
|
|
next: typeListPtr;
|
|
theType: typePtr;
|
|
end;
|
|
|
|
var
|
|
lCodeGeneration: boolean; {local copy of codeGeneration}
|
|
tempExpr: tokenPtr; {temporary to hold expression trees}
|
|
controllingType: typeRecord; {type of controlling expression}
|
|
typesSeen: typeListPtr; {types that already have associations}
|
|
tl: typeListPtr; {temporary type list pointer}
|
|
resultExpr: tokenPtr; {the result expression}
|
|
defaultExpr: tokenPtr; {the default expression}
|
|
currentType: typePtr; {the type for the current association}
|
|
typesMatch: boolean; {does the current type match}
|
|
foundMatch: boolean; {have we found a matching type?}
|
|
foundDefault: boolean; {have we found the default case?}
|
|
|
|
begin {DoGeneric}
|
|
if not expectingTerm then begin
|
|
Error(36);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
NextToken;
|
|
if token.kind <> lparench then begin
|
|
Error(36);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
new(op); {record it like a parenthesized expr}
|
|
op^.next := opStack;
|
|
op^.left := nil;
|
|
op^.middle := nil;
|
|
op^.right := nil;
|
|
opStack := op;
|
|
op^.token.kind := lparench;
|
|
op^.token.class := reservedSymbol;
|
|
parenCount := parenCount+1;
|
|
NextToken; {process the controlling expression}
|
|
tempExpr := ExpressionTree(normalExpression, [commach]);
|
|
lCodeGeneration := codeGeneration;
|
|
codeGeneration := false;
|
|
GenerateCode(tempExpr);
|
|
codeGeneration := lCodeGeneration and (numErrors = 0);
|
|
{get controlling type after conversions}
|
|
if expressionType^.kind = functionType then begin
|
|
controllingType.size := cgPointerSize;
|
|
controllingType.kind := pointerType;
|
|
controllingType.pType := expressionType;
|
|
end {if}
|
|
else if expressionType^.kind in [structType,unionType] then begin
|
|
controllingType.size := expressionType^.size;
|
|
controllingType.kind := definedType;
|
|
controllingType.dType := expressionType;
|
|
end {else if}
|
|
else
|
|
controllingType := expressionType^;
|
|
if controllingType.kind = arrayType then begin
|
|
controllingType.kind := pointerType;
|
|
controllingType.size := cgPointerSize;
|
|
end; {if}
|
|
controllingType.qualifiers := [];
|
|
controllingType.saveDisp := 0;
|
|
|
|
typesSeen := nil;
|
|
resultExpr := nil;
|
|
defaultExpr := nil;
|
|
foundMatch := false;
|
|
foundDefault := false;
|
|
while token.kind = commach do begin {process the generic associations}
|
|
NextToken;
|
|
typesMatch := false;
|
|
if token.kind <> defaultsy then begin
|
|
if not (token.kind in specifierQualifierListElement) then begin
|
|
Error(26);
|
|
while not (token.kind in [colonch,commach,rparench,eofsy]) do
|
|
NextToken;
|
|
end; {if}
|
|
currentType := TypeName; {get the type name}
|
|
if (currentType^.size = 0) or (currentType^.kind = functionType) then
|
|
Error(133);
|
|
tl := typesSeen; {check if it is a duplicate}
|
|
while tl <> nil do begin
|
|
if StrictCompTypes(currentType, tl^.theType) then begin
|
|
Error(158);
|
|
goto 10;
|
|
end; {if}
|
|
tl := tl^.next;
|
|
end; {while}
|
|
new(tl); {record it as seen}
|
|
tl^.next := typesSeen;
|
|
tl^.theType := currentType;
|
|
typesSeen := tl;
|
|
{see if the types match}
|
|
typesMatch := StrictCompTypes(currentType, controllingType);
|
|
if typesMatch then begin
|
|
if foundMatch then begin {sanity check - should never happen}
|
|
typesMatch := false;
|
|
Error(158);
|
|
end; {if}
|
|
foundMatch := true;
|
|
end; {if}
|
|
end {if}
|
|
else begin {handle default association}
|
|
NextToken;
|
|
currentType := nil;
|
|
if foundDefault then
|
|
Error(159);
|
|
foundDefault := true;
|
|
end; {else}
|
|
10:
|
|
if token.kind = colonch then {skip the colon}
|
|
NextToken
|
|
else
|
|
Error(29);
|
|
{get the expression in this association}
|
|
if (currentType = nil) and (defaultExpr = nil) and not foundMatch then
|
|
defaultExpr := ExpressionTree(kind, [commach,rparench])
|
|
else if typesMatch then
|
|
resultExpr := ExpressionTree(kind, [commach,rparench])
|
|
else
|
|
tempExpr := ExpressionTree(normalExpression, [commach,rparench]);
|
|
end; {while}
|
|
if token.kind <> rparench then
|
|
Error(12);
|
|
while typesSeen <> nil do begin {dispose of the list of types seen}
|
|
tl := typesSeen^.next;
|
|
dispose(typesSeen);
|
|
typesSeen := tl;
|
|
end; {while}
|
|
|
|
if not foundMatch then {use default if no match found}
|
|
if foundDefault then
|
|
resultExpr := defaultExpr;
|
|
if not (foundMatch or foundDefault) then begin
|
|
Error(160); {report error & synthesize a token}
|
|
resultExpr := pointer(Calloc(sizeof(tokenRecord)));
|
|
resultExpr^.token.kind := intconst;
|
|
resultExpr^.token.class := intConstant;
|
|
{resultExpr^.token.ival := 0;}
|
|
end; {if}
|
|
if resultExpr <> nil then begin
|
|
resultExpr^.next := stack; {stack the resulting expression}
|
|
stack := resultExpr;
|
|
end; {if}
|
|
expectingTerm := false;
|
|
end; {DoGeneric}
|
|
|
|
|
|
procedure DoCompoundLiteral;
|
|
|
|
{ process a compound literal expression }
|
|
|
|
label 1;
|
|
|
|
var
|
|
id: identPtr;
|
|
sp: tokenPtr;
|
|
|
|
begin {DoCompoundLiteral}
|
|
if kind in [preprocessorExpression,arrayExpression] then begin
|
|
op := opStack;
|
|
while op <> nil do begin
|
|
if op^.token.kind = sizeofsy then
|
|
goto 1;
|
|
op := op^.next;
|
|
end; {while}
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {if}
|
|
1:
|
|
id := MakeCompoundLiteral(opStack^.castType);
|
|
opStack := opStack^.next;
|
|
|
|
{create an operand on the stack}
|
|
new(sp);
|
|
if id^.class = staticsy then
|
|
sp^.token.kind := ident
|
|
else
|
|
sp^.token.kind := compoundliteral;
|
|
sp^.token.class := identifier;
|
|
sp^.token.symbolPtr := id;
|
|
sp^.token.name := id^.name;
|
|
sp^.id := id;
|
|
sp^.next := stack;
|
|
sp^.left := nil;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
stack := sp;
|
|
|
|
ComplexTerm;
|
|
expectingTerm := false;
|
|
end; {DoCompoundLiteral}
|
|
|
|
|
|
begin {ExpressionTree}
|
|
opStack := nil;
|
|
stack := nil;
|
|
if token.kind = typedef then {handle typedefs that are hidden}
|
|
if FindSymbol(token,allSpaces,false,true) <> nil then
|
|
if token.symbolPtr^.class <> typedefsy then
|
|
token.kind := ident;
|
|
if token.kind in startExpression then begin
|
|
expressionValue := 0; {initialize the expression value}
|
|
expectingTerm := true; {the first item should be a term}
|
|
done := false; {convert the expression to postfix form}
|
|
parenCount := 0;
|
|
repeat {scan the token list...}
|
|
if token.kind in startTerm then begin
|
|
|
|
{we must expect a term or unary operand}
|
|
if not expectingTerm then begin
|
|
Error(36);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
if token.kind = ident then
|
|
|
|
{handle a complex operand}
|
|
DoOperand
|
|
else begin
|
|
{handle a constant operand}
|
|
new(sp);
|
|
sp^.token := token;
|
|
sp^.next := stack;
|
|
sp^.left := nil;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
stack := sp;
|
|
if kind in [preprocessorExpression,arrayExpression] then
|
|
if token.kind in [stringconst,floatconst,doubleconst,
|
|
extendedconst,compconst] then begin
|
|
if kind = arrayExpression then begin
|
|
op := opStack;
|
|
if token.kind <> stringconst then
|
|
if op <> nil then
|
|
if op^.token.kind = castoper then
|
|
if op^.casttype^.kind = scalarType then
|
|
if op^.casttype^.baseType in [cgByte,cgUByte,
|
|
cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]
|
|
then goto 3;
|
|
while op <> nil do begin
|
|
if op^.token.kind = sizeofsy then
|
|
goto 3;
|
|
op := op^.next;
|
|
end; {while}
|
|
end; {if}
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {if}
|
|
3:
|
|
NextToken;
|
|
ComplexTerm;
|
|
end; {else}
|
|
expectingTerm := false; {the next thing should be an operation}
|
|
end {else}
|
|
{handle a closing parenthesis}
|
|
else if (token.kind = rparench) and (parenCount > 0) then begin
|
|
if expectingTerm then begin {make sure it is in a legal spot}
|
|
Error(37);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
while opStack^.token.kind <> lparench do
|
|
Operation; {do pending operations}
|
|
op := opStack;
|
|
opStack := op^.next;
|
|
dispose(op);
|
|
parenCount := parenCount-1;
|
|
NextToken; {skip the ')'}
|
|
ComplexTerm; {handle subscripts, selection, etc.}
|
|
end {else}
|
|
else if token.kind = lparench then begin
|
|
|
|
{handle open paren and type casts}
|
|
if not expectingTerm then begin
|
|
Error(38);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
NextToken;
|
|
if token.kind in specifierQualifierListElement then begin
|
|
doingSizeof := false;
|
|
doingAlignof := false;
|
|
if opStack <> nil then
|
|
if opStack^.token.kind = sizeofsy then
|
|
doingSizeof := true
|
|
else if opStack^.token.kind = _Alignofsy then
|
|
doingAlignof := true;
|
|
tType := TypeName;
|
|
if doingSizeof or doingAlignof then begin
|
|
|
|
{handle a sizeof operator}
|
|
op := opStack;
|
|
opStack := op^.next;
|
|
dispose(op);
|
|
new(sp);
|
|
sp^.next := stack;
|
|
sp^.left := nil;
|
|
sp^.middle := nil;
|
|
sp^.right := nil;
|
|
sp^.token.kind := ulongconst;
|
|
sp^.token.class := longConstant;
|
|
if doingSizeof then
|
|
sp^.token.lval := tType^.size
|
|
else {if doingAlignof then}
|
|
sp^.token.lval := 1;
|
|
with tType^ do
|
|
if (size = 0) or ((kind = arrayType) and (elements = 0)) then
|
|
Error(133);
|
|
sp^.next := stack;
|
|
stack := sp;
|
|
expectingTerm := false;
|
|
end {if}
|
|
else {doing a cast} begin
|
|
|
|
{handle a type cast}
|
|
new(op); {stack the cast operator}
|
|
op^.left := nil;
|
|
op^.middle := nil;
|
|
op^.right := nil;
|
|
op^.castType := tType;
|
|
op^.token.kind := castoper;
|
|
op^.token.class := reservedWord;
|
|
op^.next := opStack;
|
|
opStack := op;
|
|
end; {else}
|
|
Match(rparench,12);
|
|
end {if}
|
|
else begin
|
|
new(op); {record the '('}
|
|
op^.next := opStack;
|
|
op^.left := nil;
|
|
op^.middle := nil;
|
|
op^.right := nil;
|
|
opStack := op;
|
|
op^.token.kind := lparench;
|
|
op^.token.class := reservedSymbol;
|
|
parenCount := parenCount+1;
|
|
end;
|
|
end {else if}
|
|
else if (token.kind = lbracech) {handle a compound literal}
|
|
and (opstack <> nil) and (opStack^.token.kind = castoper) then begin
|
|
DoCompoundLiteral
|
|
end {else if}
|
|
else if token.kind = _Genericsy then {handle _Generic}
|
|
DoGeneric
|
|
else begin {handle an operation...}
|
|
if expectingTerm then {convert unary operators to separate tokens}
|
|
if token.kind in [asteriskch,minusch,plusch,andch] then
|
|
case token.kind of
|
|
asteriskch: token.kind := uasterisk;
|
|
minusch : token.kind := uminus;
|
|
andch : token.kind := uand;
|
|
plusch : begin
|
|
NextToken;
|
|
goto 2;
|
|
end;
|
|
otherwise : Error(57);
|
|
end; {case}
|
|
if icp[token.kind] = notAnOperation then
|
|
done := true {end of expression found...}
|
|
else if (token.kind in stopSym) and (parenCount = 0)
|
|
and ((opStack = nil) or (opStack^.token.kind <> questionch)) then
|
|
done := true
|
|
else begin
|
|
if not (kind in [normalExpression, autoInitializerExpression]) then
|
|
if (token.kind in
|
|
[plusplusop,minusminusop,eqch,pluseqop,minuseqop,
|
|
opplusplus,opminusminus,
|
|
asteriskeqop,slasheqop,percenteqop,ltlteqop,
|
|
gtgteqop,caroteqop,bareqop,commach])
|
|
or ((kind = preprocessorExpression)
|
|
and (token.kind = sizeofsy))
|
|
or ((kind <> initializerExpression)
|
|
and (token.kind = uand)) then begin
|
|
Error(161);
|
|
errorFound := true;
|
|
end; {if}
|
|
if token.kind in {make sure we get what we want}
|
|
[plusplusop,minusminusop,sizeofsy,_Alignofsy,tildech,excch,
|
|
uasterisk,uminus,uand] then begin
|
|
if not expectingTerm then begin
|
|
Error(38);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
if expectingTerm then begin
|
|
Error(37);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
expectingTerm := true;
|
|
{handle 2nd half of ternary operator}
|
|
if token.kind = colonch then begin
|
|
done2 := false; {do pending operations}
|
|
repeat
|
|
if opStack = nil then
|
|
done2 := true
|
|
else if opStack^.token.kind <> questionch then
|
|
Operation
|
|
else
|
|
done2 := true;
|
|
until done2;
|
|
if (opStack = nil) or
|
|
(opStack^.token.kind <> questionch) then begin
|
|
Error(39);
|
|
Skip;
|
|
goto 1;
|
|
end; {if}
|
|
op := opStack;
|
|
opStack := op^.next;
|
|
dispose(op);
|
|
end {if}
|
|
else begin
|
|
done2 := false; {do operations with less precedence}
|
|
repeat
|
|
if opStack = nil then
|
|
done2 := true
|
|
else if isp[opStack^.token.kind] >= icp[token.kind] then
|
|
Operation
|
|
else
|
|
done2 := true;
|
|
until done2;
|
|
end; {else}
|
|
end; {else}
|
|
new(op); {record the operation}
|
|
op^.next := opStack;
|
|
op^.left := nil;
|
|
op^.middle := nil;
|
|
op^.right := nil;
|
|
opStack := op;
|
|
op^.token := token;
|
|
NextToken;
|
|
end; {else}
|
|
end; {else}
|
|
2:
|
|
until done;
|
|
if parenCount > 0 then begin
|
|
Error(12);
|
|
errorFound := true;
|
|
end {if}
|
|
else begin
|
|
while opStack <> nil do {do pending operations}
|
|
Operation;
|
|
{there should be exactly one operand left}
|
|
if (stack = nil) or (stack^.next <> nil) then begin
|
|
Error(36);
|
|
errorFound := true;
|
|
end; {if}
|
|
end; {else}
|
|
end {if}
|
|
else begin {the start of an expression was not found}
|
|
Error(35);
|
|
if not (token.kind in stopSym) then
|
|
NextToken;
|
|
Skip;
|
|
end; {else}
|
|
1:
|
|
if errorFound then begin
|
|
while opStack <> nil do begin
|
|
op := opStack;
|
|
opStack := op^.next;
|
|
dispose(op);
|
|
end; {while}
|
|
while stack <> nil do begin
|
|
sp := stack;
|
|
stack := sp^.next;
|
|
DisposeTree(sp);
|
|
end; {while}
|
|
ExpressionTree := nil;
|
|
end {if}
|
|
else
|
|
ExpressionTree := stack;
|
|
end; {ExpressionTree}
|
|
|
|
|
|
procedure CompareToZero {op: pcodes};
|
|
|
|
{ Compare the result on tos to zero. }
|
|
{ }
|
|
{ This procedure is used by the logical statements to compare }
|
|
{ _any_ scalar result to zero, giving a boolean result. }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation to use on the compare }
|
|
|
|
var
|
|
bt: baseTypeEnum; {base type of loaded value}
|
|
|
|
begin {CompareToZero}
|
|
if expressionType^.kind in [pointerType,arrayType] then
|
|
expressionType := uLongPtr;
|
|
if expressionType^.kind = scalarType then begin
|
|
bt := UsualUnaryConversions;
|
|
case bt of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen1t(pc_ldc, 0, cgWord);
|
|
cgLong,cgULong:
|
|
GenLdcLong(0);
|
|
cgQuad,cgUQuad:
|
|
GenLdcQuad(longlong0);
|
|
cgReal,cgDouble,cgComp,cgExtended:
|
|
GenLdcReal(0.0);
|
|
otherwise:
|
|
Error(47);
|
|
end; {case}
|
|
expressionType := intPtr;
|
|
Gen0t(op, bt);
|
|
end {if}
|
|
else
|
|
Error(47);
|
|
end; {CompareToZero}
|
|
|
|
|
|
procedure FreeTemp{labelNum, size: integer};
|
|
|
|
{ place a temporary label in the available label list }
|
|
{ }
|
|
{ parameters: }
|
|
{ labelNum - number of the label to free }
|
|
{ size - size of the variable }
|
|
{ }
|
|
{ variables: }
|
|
{ tempList - list of free labels }
|
|
|
|
var
|
|
tl: tempPtr; {work pointer}
|
|
|
|
begin {FreeTemp}
|
|
new(tl);
|
|
tl^.next := tempList;
|
|
tl^.last := nil;
|
|
tl^.labelNum := labelNum;
|
|
tl^.size := size;
|
|
if tempList <> nil then
|
|
tempList^.last := tl;
|
|
tempList := tl;
|
|
end; {FreeTemp}
|
|
|
|
|
|
function GetTemp{size: integer): integer};
|
|
|
|
{ find a temporary work variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ size - size of the variable }
|
|
{ }
|
|
{ variables: }
|
|
{ tempList - list of free labels }
|
|
{ }
|
|
{ Returns the label number. }
|
|
|
|
label 1;
|
|
|
|
var
|
|
lcodeGeneration: boolean; {local copy of codeGeneration}
|
|
ln: integer; {label number}
|
|
tl: tempPtr; {work pointer}
|
|
|
|
begin {GetTemp}
|
|
{try to find a temp from the existing list}
|
|
tl := tempList;
|
|
while tl <> nil do begin
|
|
if tl^.size = size then begin
|
|
|
|
{found an old one - use it}
|
|
if tl^.last = nil then
|
|
tempList := tl^.next
|
|
else
|
|
tl^.last^.next := tl^.next;
|
|
if tl^.next <> nil then
|
|
tl^.next^.last := tl^.last;
|
|
GetTemp := tl^.labelNum;
|
|
goto 1;
|
|
end; {if}
|
|
tl := tl^.next;
|
|
end; {while}
|
|
|
|
{none found - get a new one}
|
|
ln := GetLocalLabel;
|
|
GetTemp := ln;
|
|
lcodeGeneration := codeGeneration;
|
|
codeGeneration := true;
|
|
Gen2(dc_loc, ln, size);
|
|
codeGeneration := lCodeGeneration and (numErrors = 0);
|
|
1:
|
|
end; {GetTemp}
|
|
|
|
|
|
procedure LoadScalar (id: identPtr);
|
|
|
|
{ Load a scalar value. }
|
|
{ }
|
|
{ parameters: }
|
|
{ id - ident for value to load }
|
|
|
|
var
|
|
tp: baseTypeEnum; {base type}
|
|
|
|
begin {LoadScalar}
|
|
if id^.itype^.kind = scalarType then
|
|
tp := id^.itype^.baseType
|
|
else {if id^.itype^.kind in [pointerType,arrayType] then}
|