mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-10-31 17:04:42 +00:00
4020098dd6
Note that we currently defer evaluation of such expressions to run time if the long long value cannot be represented exactly in a double, because statically-evaluated floating point expressions use the double format rather than the extended (long double) format used at run time.
4447 lines
163 KiB
ObjectPascal
4447 lines
163 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}
|
|
{---------------------------------------------------------------}
|
|
|
|
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 }
|
|
|
|
|
|
procedure TypeName; extern;
|
|
|
|
{ process a type name (used for casts and sizeof/_Alignof) }
|
|
{ }
|
|
{ outputs: }
|
|
{ typeSpec - pointer to the type }
|
|
|
|
{-- 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,cgReal,cgDouble,cgComp] then
|
|
if tp in [cgByte,cgUByte] then
|
|
tp := cgWord
|
|
else {if tp in [cgReal,cgDouble,cgComp] then}
|
|
tp := cgExtended;
|
|
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}
|
|
|
|
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 = cgExtended then begin
|
|
if rt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
|
|
Gen2(pc_cnv, ord(rt), ord(cgExtended));
|
|
UsualBinaryConversions := cgExtended;
|
|
expressionType := extendedPtr;
|
|
end {if}
|
|
else if rt = cgExtended then begin
|
|
if lt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
|
|
Gen2(pc_cnn, ord(lt), ord(cgExtended));
|
|
UsualBinaryConversions := cgExtended;
|
|
expressionType := extendedPtr;
|
|
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
|
|
else if lt = cgExtended then
|
|
expressionType := extendedPtr;
|
|
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
|
|
else if et = cgExtended then
|
|
expressionType := extendedPtr;
|
|
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 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 t1^.isConstant then
|
|
if genCode then
|
|
if checkConst 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 = 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);
|
|
end {if}
|
|
else if kind2 = arrayType then begin
|
|
if not CompTypes(t1^.ptype, t2^.atype) then
|
|
if t1^.ptype^.baseType <> cgVoid then
|
|
Error(47);
|
|
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}
|
|
|
|
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.kind := longconst;
|
|
stack^.token.lval := 0;
|
|
end {if}
|
|
|
|
{if the id is not declared, create a function returning integer}
|
|
else if id = nil then begin
|
|
if token.kind = lparench then begin
|
|
fnPtr := pointer(GCalloc(sizeof(typeRecord)));
|
|
{fnPtr^.size := 0;}
|
|
{fnPtr^.saveDisp := 0;}
|
|
{fnPtr^.isConstant := false;}
|
|
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;
|
|
|
|
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: double; {for evaluating double expressions}
|
|
llop1, llop2: longlong; {for evaluating long long expressions}
|
|
extop1: extended; {temporary for conversions}
|
|
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 = intconst then
|
|
RealVal := token.ival
|
|
else if token.kind = uintconst 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 = intconst then
|
|
IntVal := token.ival
|
|
else if token.kind = uintconst 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 = intconst then begin
|
|
result.lo := token.ival;
|
|
if result.lo < 0 then
|
|
result.hi := -1
|
|
else
|
|
result.hi := 0;
|
|
end {if}
|
|
else if token.kind = uintconst 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,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,
|
|
longconst,ulongconst,longlongconst,ulonglongconst] then
|
|
if op^.left^.token.kind in [intconst,uintconst,
|
|
longconst,ulongconst,longlongconst,ulonglongconst] then
|
|
if op^.middle^.token.kind in [intconst,uintconst,
|
|
longconst,ulongconst,longlongconst,ulonglongconst] then begin
|
|
GetLongLongVal(llop1, op^.left^.token);
|
|
if (llop1.lo <> 0) or (llop1.hi <> 0) then
|
|
op^.token := op^.middle^.token
|
|
else
|
|
op^.token := op^.right^.token;
|
|
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,longconst,ulongconst] then begin
|
|
if kindLeft in [intconst,uintconst,longconst,ulongconst] 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) 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,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,longconst,ulongconst,
|
|
longlongconst,ulonglongconst] then begin
|
|
if kindLeft in [intconst,uintconst,longconst,ulongconst,
|
|
longlongconst,ulonglongconst] 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.hi := 0;
|
|
llop1.lo :=
|
|
ord((llop1.lo <> 0) or (llop1.hi <> 0) or
|
|
(llop2.lo <> 0) or (llop2.hi <> 0));
|
|
ekind := intconst;
|
|
end;
|
|
andandop : begin {&&}
|
|
llop1.hi := 0;
|
|
llop1.lo :=
|
|
ord(((llop1.lo <> 0) or (llop1.hi <> 0)) and
|
|
((llop2.lo <> 0) or (llop2.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.hi := 0;
|
|
llop1.lo := ord((llop1.lo = llop2.lo) and
|
|
(llop1.hi = llop2.hi));
|
|
ekind := intconst;
|
|
end;
|
|
exceqop : begin {!=}
|
|
llop1.hi := 0;
|
|
llop1.lo := ord((llop1.lo <> llop2.lo) or
|
|
(llop1.hi <> llop2.hi));
|
|
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,doubleconst] then
|
|
if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,
|
|
longlongconst,ulonglongconst,doubleconst] then
|
|
begin
|
|
ekind := doubleconst; {evaluate a constant operation}
|
|
extop1 := RealVal(op^.left^.token);
|
|
rop1 := extop1;
|
|
if op^.left^.token.kind in [longlongconst,ulonglongconst] then
|
|
if rop1 <> extop1 then
|
|
if not (op^.token.kind in [barbarop,andandop]) then
|
|
goto 1;
|
|
extop1 := RealVal(op^.right^.token);
|
|
rop2 := extop1;
|
|
if op^.right^.token.kind in [longlongconst,ulonglongconst] then
|
|
if rop2 <> extop1 then
|
|
if not (op^.token.kind in [barbarop,andandop]) then
|
|
goto 1;
|
|
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 := doubleConstant;
|
|
op^.token.kind := doubleConst;
|
|
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+1
|
|
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,
|
|
doubleConstant] then begin
|
|
tp := op^.castType;
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
if tp^.kind = scalarType then begin
|
|
baseType := tp^.baseType;
|
|
if (baseType < cgString) or (baseType in [cgQuad,cgUQuad])
|
|
then begin
|
|
if class = doubleConstant 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
|
|
extop1 := CnvULLX(llop1)
|
|
else
|
|
extop1 := CnvLLX(llop1);
|
|
rop1 := extop1;
|
|
if baseType in [cgExtended,cgComp] then
|
|
if rop1 <> extop1 then
|
|
goto 3;
|
|
end; {else if}
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
if baseType in [cgByte,cgWord] then begin
|
|
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
|
|
op^.token.kind := intConst;
|
|
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
|
|
op^.token.kind := doubleConst;
|
|
op^.token.class := doubleConstant;
|
|
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]) then begin
|
|
|
|
{evaluate a constant operation}
|
|
ekind := op^.left^.token.kind;
|
|
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] then begin
|
|
|
|
{evaluate a constant operation with long long operand}
|
|
ekind := op^.left^.token.kind;
|
|
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 = doubleconst then begin
|
|
ekind := doubleconst; {evaluate a constant operation}
|
|
rop1 := RealVal(op^.left^.token);
|
|
dispose(op^.left);
|
|
op^.left := nil;
|
|
case op^.token.kind of
|
|
uminus : begin {unary -}
|
|
op^.token.class := doubleConstant;
|
|
op^.token.kind := doubleConst;
|
|
op^.token.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 := doubleConstant;
|
|
op^.token.kind := doubleConst;
|
|
op^.token.rval := rop1;
|
|
end;
|
|
end; {case}
|
|
end; {if}
|
|
end; {if}
|
|
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}
|
|
|
|
|
|
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 if token.kind = _Genericsy then begin
|
|
Error(144);
|
|
Skip;
|
|
goto 1;
|
|
end
|
|
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,doubleconst] then begin
|
|
if kind = arrayExpression then begin
|
|
op := opStack;
|
|
if token.kind = doubleconst 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;
|
|
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 := typeSpec^.size
|
|
else {if doingAlignof then}
|
|
sp^.token.lval := 1;
|
|
with typeSpec^ 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 := typeSpec;
|
|
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 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) 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(40);
|
|
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}
|
|
tp := cgULong;
|
|
case id^.storage of
|
|
stackFrame, parameter:
|
|
Gen2t(pc_lod, id^.lln, 0, tp);
|
|
external, global, private:
|
|
Gen1tName(pc_ldo, 0, tp, id^.name);
|
|
otherwise: ;
|
|
end; {case}
|
|
end; {LoadScalar}
|
|
|
|
|
|
procedure Cast(tp: typePtr);
|
|
|
|
{ Cast the current expression to the stated type }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - type to cast to }
|
|
{ }
|
|
{ inputs: }
|
|
{ expressionType - type of the expression to cast }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
var
|
|
et,rt: baseTypeEnum; {work variables}
|
|
|
|
begin {Cast}
|
|
if (tp^.kind = scalarType) and (tp^.cType = ctBool) then begin
|
|
CompareToZero(pc_neq);
|
|
end {if}
|
|
else if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin
|
|
rt := tp^.baseType;
|
|
et := expressionType^.baseType;
|
|
if rt <> et then
|
|
if et <> cgVoid then
|
|
Gen2(pc_cnv, ord(et), ord(rt))
|
|
else
|
|
Error(40);
|
|
end {if}
|
|
else if (tp^.kind = enumType) and (expressionType^.kind = scalarType) then begin
|
|
if expressionType^.baseType <> cgVoid then begin
|
|
rt := cgWord;
|
|
et := Unary(expressionType^.baseType);
|
|
if rt <> et then
|
|
Gen2(pc_cnv, ord(et), ord(rt));
|
|
end {if}
|
|
else
|
|
Error(40);
|
|
end {if}
|
|
else if (tp^.kind = scalarType) and (expressionType^.kind = enumType) then begin
|
|
rt := Unary(tp^.baseType);
|
|
et := cgWord;
|
|
if rt <> et then
|
|
Gen2(pc_cnv, ord(et), ord(rt));
|
|
end {if}
|
|
else if tp^.kind = pointerType then begin
|
|
case expressionType^.kind of
|
|
|
|
scalarType:
|
|
if expressionType^.baseType in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then
|
|
Gen2(pc_cnv, ord(Unary(expressionType^.baseType)),
|
|
ord(cgULong))
|
|
else if doDispose then
|
|
Error(40);
|
|
|
|
arrayType,pointerType: ;
|
|
|
|
functionType,enumConst,enumType,definedType,structType,unionType:
|
|
if doDispose then
|
|
Error(40);
|
|
|
|
otherwise: Error(57);
|
|
|
|
end; {case}
|
|
end {else if}
|
|
else if expressionType^.kind in [pointerType,arrayType] then begin
|
|
case tp^.kind of
|
|
|
|
scalarType:
|
|
if tp^.baseType in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong] then
|
|
Gen2(pc_cnv, ord(cgULong),
|
|
ord(Unary(tp^.baseType)))
|
|
else if tp^.baseType = cgVoid then
|
|
Gen0t(pc_pop, UsualUnaryConversions)
|
|
else
|
|
Error(40);
|
|
|
|
otherwise:
|
|
Error(40);
|
|
end; {case}
|
|
end {else if}
|
|
else if expressionType^.kind in [structType,unionType] then begin
|
|
if tp^.kind = scalarType then
|
|
if tp^.baseType = cgVoid then
|
|
Gen0t(pc_pop, UsualUnaryConversions)
|
|
else Error(40)
|
|
else Error(40);
|
|
end {else if}
|
|
else
|
|
Error(40);
|
|
expressionType := tp;
|
|
end; {Cast}
|
|
|
|
|
|
procedure DoSelection {lType: typePtr; tree: tokenPtr; var size: longint};
|
|
|
|
{ Find the displacement & type for a selection operation }
|
|
{ }
|
|
{ parameters: }
|
|
{ lType - structure/union type }
|
|
{ tree - right-hand tree }
|
|
{ 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 }
|
|
|
|
label 1;
|
|
|
|
var
|
|
ip: identPtr; {for scanning for the field}
|
|
|
|
begin {DoSelection}
|
|
expressionType := intPtr; {set defaults in case there is an error}
|
|
size := 0;
|
|
if tree^.token.class = identifier then begin
|
|
while lType^.kind = definedType do
|
|
lType := lType^.dType;
|
|
if lType^.kind in [structType,unionType] then begin
|
|
ip := lType^.fieldList; {find a matching field}
|
|
while ip <> nil do begin
|
|
if ip^.name^ = tree^.token.name^ then begin
|
|
if ip^.isForwardDeclared then
|
|
ResolveForwardReference(ip);
|
|
size := ip^.disp; {match found - record parameters}
|
|
expressionType := ip^.itype;
|
|
bitDisp := ip^.bitDisp;
|
|
bitSize := ip^.bitSize;
|
|
isBitField := (bitSize+bitDisp) <> 0;
|
|
unsigned := (ip^.itype^.baseType in [cgUByte,cgUWord,cgULong])
|
|
or (ip^.itype^.cType = ctBool);
|
|
goto 1;
|
|
end; {if}
|
|
ip := ip^.next;
|
|
end; {while}
|
|
Error(81);
|
|
end {if}
|
|
else
|
|
Error(80);
|
|
end; {if}
|
|
1:
|
|
end; {DoSelection}
|
|
|
|
|
|
procedure L_Value(tree: tokenPtr);
|
|
|
|
{ Check for an l-value }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - expression tree to check }
|
|
|
|
var
|
|
kind: tokenEnum; {for efficiency}
|
|
|
|
begin {L_Value}
|
|
kind := tree^.token.kind;
|
|
|
|
{A variable identifier is an l-value unless it is a function or }
|
|
{non-parameter array }
|
|
if kind = ident then begin
|
|
if tree^.id^.itype^.kind = arrayType then begin
|
|
if tree^.id^.storage <> parameter then
|
|
if doDispose then {prevent spurious errors}
|
|
Error(78);
|
|
end {if}
|
|
else if tree^.id^.itype^.kind in
|
|
[functionType,enumConst,enumType] then
|
|
if doDispose then {prevent spurious errors}
|
|
Error(78);
|
|
end {if}
|
|
|
|
{e.field is an l-value if and only if e is an l-value}
|
|
else if kind = dotch then
|
|
L_Value(tree^.left)
|
|
|
|
{Bypass cast operators }
|
|
{following test removed to flag bug for: }
|
|
{ int *p; long l; }
|
|
{ (long) p = l; }
|
|
{else if kind = castoper then
|
|
L_Value(tree^.left)}
|
|
|
|
{The result of an array subscript (a[i]), indirect selection, }
|
|
{or the indirection operator all show up as the uasterisk }
|
|
{operator at this point. All are l-values, but nothing else }
|
|
{not already allowed is an l-value. }
|
|
else if kind <> uasterisk then
|
|
if doDispose then {prevent spurious errors}
|
|
Error(78);
|
|
end; {L_Value}
|
|
|
|
|
|
procedure ChangePointer (op: pcodes; size: longint; tp: baseTypeEnum);
|
|
|
|
{ Add or subtract an integer to a pointer }
|
|
{ }
|
|
{ The stack has a pointer and an integer (integer on TOS). }
|
|
{ The integer is removed, multiplied by size, and either }
|
|
{ added to or subtracted from the pointer; the result }
|
|
{ replaces the pointer on the stack }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation (pc_adl or pc_sbl) }
|
|
{ size - size of one pointer element }
|
|
{ tp - type of the integer operand }
|
|
|
|
begin {ChangePointer}
|
|
if size = 0 then
|
|
Error(122);
|
|
case tp of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
if (size = long(size).lsw) and (op = pc_adl)
|
|
and smallMemoryModel and (tp in [cgUByte,cgUWord]) then begin
|
|
if size <> 1 then begin
|
|
Gen1t(pc_ldc, long(size).lsw, cgWord);
|
|
Gen0(pc_umi);
|
|
end; {if}
|
|
Gen0t(pc_ixa, cgUWord);
|
|
end {if}
|
|
else if smallMemoryModel and (size = long(size).lsw) then begin
|
|
if size <> 1 then begin
|
|
Gen1t(pc_ldc, long(size).lsw, cgWord);
|
|
Gen0(pc_umi);
|
|
end; {if}
|
|
Gen2(pc_cnv, ord(tp), ord(cgLong));
|
|
Gen0(op);
|
|
end {else if}
|
|
else begin
|
|
Gen2(pc_cnv, ord(tp), ord(cgLong));
|
|
if size <> 1 then begin
|
|
GenLdcLong(size);
|
|
Gen0(pc_mpl);
|
|
end; {if}
|
|
Gen0(op);
|
|
end;
|
|
end;
|
|
cgLong,cgULong,cgQuad,cgUQuad: begin
|
|
if tp in [cgQuad,cgUQuad] then
|
|
Gen2(pc_cnv, ord(tp), ord(cgLong));
|
|
if size <> 1 then begin
|
|
GenLdcLong(size);
|
|
if tp in [cgLong,cgQuad] then
|
|
Gen0(pc_mpl)
|
|
else
|
|
Gen0(pc_uml);
|
|
end; {if}
|
|
Gen0(op);
|
|
end;
|
|
otherwise:
|
|
Error(66);
|
|
end; {case}
|
|
end; {ChangePointer}
|
|
|
|
|
|
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 }
|
|
|
|
var
|
|
doingScalar: boolean; {temp; for assignment operators}
|
|
et: baseTypeEnum; {temp storage for a base type}
|
|
i: integer; {loop variable}
|
|
isString: boolean; {was the ? : a string?}
|
|
lType: typePtr; {type of operands}
|
|
kind: typeKind; {temp type kind}
|
|
size: longint; {size of an array element}
|
|
t1: integer; {temporary work space label number}
|
|
tlastwasconst: boolean; {temp lastwasconst}
|
|
tlastconst: longint; {temp lastconst}
|
|
tp: tokenPtr; {work pointer}
|
|
tType: typePtr; {temp type of operand}
|
|
|
|
lbitDisp,lbitSize: integer; {for temp storage}
|
|
lisBitField: boolean;
|
|
|
|
|
|
function ExpressionKind (tree: tokenPtr): typeKind;
|
|
|
|
{ returns the type of an expression }
|
|
{ }
|
|
{ This subroutine is used to see if + and - operations }
|
|
{ should do pointer addition. }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - top of the expression tree to check }
|
|
|
|
var
|
|
ldoDispose: boolean; {local copy of doDispose}
|
|
lcodeGeneration: boolean; {local copy of codeGeneration}
|
|
lexpressionType: typePtr; {local copy of expressionType}
|
|
|
|
begin {ExpressionKind}
|
|
ldoDispose := doDispose; {inhibit disposing of the tree}
|
|
doDispose := false;
|
|
lcodeGeneration := codeGeneration; {inhibit code generation}
|
|
codeGeneration := false;
|
|
lexpressionType := expressionType; {save the expression type}
|
|
|
|
GenerateCode(tree); {get the type}
|
|
while expressionType^.kind = definedType do
|
|
expressionType := expressionType^.dType;
|
|
ExpressionKind := expressionType^.kind;
|
|
|
|
doDispose := ldoDispose; {restore the volatile variables}
|
|
codeGeneration := lCodeGeneration and (numErrors = 0);
|
|
expressionType := lexpressionType;
|
|
end; {ExpressionKind}
|
|
|
|
|
|
procedure LoadAddress (tree: tokenPtr);
|
|
|
|
{ load the address of an l-value }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - top of the expression tree to load the }
|
|
{ address of }
|
|
{ }
|
|
{ variables: }
|
|
{ expressionType - result type of the expression }
|
|
{ isBitField - this variable is set to false so that }
|
|
{ it can be used to see if DoSelection was called }
|
|
{ and located a bit field }
|
|
|
|
label 1;
|
|
|
|
var
|
|
eType: typePtr; {work pointer}
|
|
i: integer; {loop variable}
|
|
size: longint; {disp in record}
|
|
tname: stringPtr; {temp name pointer}
|
|
|
|
begin {LoadAddress}
|
|
isBitField := false;
|
|
if tree^.token.kind = ident then begin
|
|
|
|
{load the address of an identifier}
|
|
with tree^.id^ do begin
|
|
tname := name;
|
|
if itype^.kind = functionType then begin
|
|
if itype^.isPascal then begin
|
|
tname := pointer(Malloc(length(name^)+1));
|
|
CopyString(pointer(tname), pointer(name));
|
|
for i := 1 to length(tname^) do
|
|
if tname^[i] in ['a'..'z'] then
|
|
tname^[i] := chr(ord(tname^[i]) & $5F);
|
|
end; {if}
|
|
end; {if}
|
|
case storage of
|
|
stackFrame: Gen2(pc_lda, lln, 0);
|
|
parameter: if itype^.kind = arrayType then
|
|
Gen2t(pc_lod, pln, 0, cgULong)
|
|
else
|
|
Gen2(pc_lda, pln, 0);
|
|
external,
|
|
global,
|
|
private: Gen1Name(pc_lao, 0, tname);
|
|
otherwise: ;
|
|
end; {case}
|
|
eType := pointer(Malloc(sizeof(typeRecord)));
|
|
eType^.size := cgLongSize;
|
|
eType^.saveDisp := 0;
|
|
eType^.isConstant := false;
|
|
eType^.kind := pointerType;
|
|
eType^.pType := iType;
|
|
expressionType := eType;
|
|
end; {with}
|
|
end {if}
|
|
else if tree^.token.kind = uasterisk then begin
|
|
|
|
{load the address of the item pointed to by the pointer}
|
|
GenerateCode(tree^.left);
|
|
isBitField := false;
|
|
if not (expressionType^.kind in [pointerType,arrayType,functionType]) then
|
|
Error(79);
|
|
end {else if}
|
|
else if tree^.token.kind = dotch then begin
|
|
|
|
{load the address of a field of a record}
|
|
LoadAddress(tree^.left);
|
|
eType := expressionType;
|
|
if eType^.kind in [arrayType,pointerType] then begin
|
|
if eType^.kind = arrayType then
|
|
eType := eType^.aType
|
|
else if eType^.kind = pointerType then
|
|
eType := eType^.pType;
|
|
DoSelection(eType, tree^.right, size);
|
|
if size <> 0 then
|
|
if size & $00007FFF = size then
|
|
Gen1t(pc_inc, long(size).lsw, cgULong)
|
|
else begin
|
|
GenLdcLong(size);
|
|
Gen0(pc_adl);
|
|
end; {else}
|
|
eType := pointer(Malloc(sizeof(typeRecord)));
|
|
eType^.size := cgLongSize;
|
|
eType^.saveDisp := 0;
|
|
eType^.isConstant := false;
|
|
eType^.kind := pointerType;
|
|
eType^.pType := expressionType;
|
|
expressionType := eType;
|
|
end {if}
|
|
else
|
|
Error(79);
|
|
end {else if}
|
|
else if tree^.token.kind = castoper then begin
|
|
|
|
{load the address of a field of a record}
|
|
LoadAddress(tree^.left);
|
|
expressionType := tree^.castType;
|
|
if expressionType^.kind <> arrayType then begin
|
|
eType := pointer(Malloc(sizeof(typeRecord)));
|
|
eType^.size := cgLongSize;
|
|
eType^.saveDisp := 0;
|
|
eType^.isConstant := false;
|
|
eType^.kind := pointerType;
|
|
eType^.pType := expressionType;
|
|
expressionType := eType;
|
|
end; {if}
|
|
end {else if}
|
|
|
|
else if ExpressionKind(tree) in [arrayType,pointerType] then
|
|
GenerateCode(tree)
|
|
else begin
|
|
expressionType := intPtr; {set default type in case of error}
|
|
if doDispose then {prevent spurious errors}
|
|
Error(78);
|
|
end; {else}
|
|
1:
|
|
end; {LoadAddress}
|
|
|
|
|
|
procedure DoIncDec (tree: tokenPtr; pc_l, pc_g, pc_i: pcodes);
|
|
|
|
{ do ++ and -- }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - tree to generate the instruction for }
|
|
{ pc_l - op code for a local ++ or -- }
|
|
{ pc_g - op code for a global ++ or -- }
|
|
{ pc_i - op code for an indirect ++ or -- }
|
|
|
|
label 1;
|
|
|
|
var
|
|
baseType: baseTypeEnum; {type of operation}
|
|
lSize: longint; {number to inc or dec by}
|
|
iSize: integer; {number to inc or dec by}
|
|
tp: baseTypeEnum; {type of operand}
|
|
|
|
|
|
procedure IncOrDec (inc: boolean);
|
|
|
|
{ Increment or decrement a number on TOS }
|
|
{ }
|
|
{ parameters: }
|
|
{ inc - increment the number? }
|
|
|
|
begin {IncOrDec}
|
|
case expressionType^.kind of
|
|
|
|
scalarType:
|
|
case tp of
|
|
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
Gen1t(pc_ldc, 1, cgWord);
|
|
if inc then
|
|
Gen0(pc_adi)
|
|
else
|
|
Gen0(pc_sbi);
|
|
if expressionType^.cType = ctBool then begin
|
|
CompareToZero(pc_neq);
|
|
expressionType := boolPtr;
|
|
end {if}
|
|
end;
|
|
|
|
cgLong,cgULong: begin
|
|
GenLdcLong(1);
|
|
if inc then
|
|
Gen0(pc_adl)
|
|
else
|
|
Gen0(pc_sbl);
|
|
end;
|
|
|
|
cgQuad,cgUQuad: begin
|
|
GenLdcQuad(longlong1);
|
|
if inc then
|
|
Gen0(pc_adq)
|
|
else
|
|
Gen0(pc_sbq);
|
|
end;
|
|
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
GenLdcReal(1.0);
|
|
if inc then
|
|
Gen0(pc_adr)
|
|
else
|
|
Gen0(pc_sbr);
|
|
end;
|
|
|
|
otherwise: Error(57);
|
|
|
|
end; {case}
|
|
|
|
pointerType,arrayType: begin
|
|
GenldcLong(expressionType^.pType^.size);
|
|
if inc then
|
|
Gen0(pc_adl)
|
|
else
|
|
Gen0(pc_sbl);
|
|
end;
|
|
|
|
otherwise: ;
|
|
|
|
end; {case}
|
|
end; {IncOrDec}
|
|
|
|
|
|
begin {DoIncDec}
|
|
L_Value(tree);
|
|
if (tree^.token.kind = ident)
|
|
and ((tree^.id^.iType^.kind in [scalarType,pointerType])
|
|
or ((tree^.id^.iType^.kind = arrayType) and (tree^.id^.storage = parameter)))
|
|
then
|
|
with tree^.id^ do begin
|
|
|
|
{check for ++ or -- of a constant}
|
|
if iType^.isConstant then
|
|
Error(93);
|
|
|
|
{do an efficient ++ or -- on a named location}
|
|
if iType^.kind = scalarType then begin
|
|
iSize := 1;
|
|
baseType := iType^.baseType;
|
|
if (baseType in [cgReal,cgDouble,cgComp,cgExtended,cgQuad,cgUQuad])
|
|
or (iType^.cType = ctBool) then begin
|
|
|
|
{do real or bool inc or dec}
|
|
LoadScalar(tree^.id); {load the value}
|
|
if pc_l in [pc_lli,pc_lld] then
|
|
if iType^.cType = ctBool then begin
|
|
t1 := GetTemp(cgWordSize);
|
|
Gen2t(pc_cop, t1, 0, cgWord);
|
|
end; {if}
|
|
tp := baseType;
|
|
expressionType := iType;
|
|
IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --}
|
|
case storage of {save the result}
|
|
stackFrame, parameter:
|
|
Gen2t(pc_cop, lln, 0, baseType);
|
|
external, global, private:
|
|
Gen1tName(pc_cpo, 0, baseType, name);
|
|
otherwise: ;
|
|
end; {case}
|
|
{correct the value for postfix ops}
|
|
if pc_l in [pc_lli,pc_lld] then
|
|
if iType^.cType = ctBool then begin
|
|
Gen0t(pc_pop, cgWord);
|
|
Gen2t(pc_lod, t1, 0, cgWord);
|
|
Gen0t(pc_bno, cgWord);
|
|
FreeTemp(t1, cgWordSize);
|
|
end {if}
|
|
else
|
|
IncOrDec(pc_l = pc_lld);
|
|
if iType^.cType = ctBool then
|
|
expressionType := boolPtr
|
|
else if baseType = cgQuad then
|
|
expressionType := longLongPtr
|
|
else if baseType = cgUQuad then
|
|
expressionType := ulongLongPtr
|
|
else
|
|
expressionType := doublePtr;
|
|
goto 1;
|
|
end; {else if}
|
|
end {if}
|
|
else {if iType^.kind in [pointerType,arrayType] then} begin
|
|
lSize := iType^.pType^.size;
|
|
if lSize = 0 then
|
|
Error(122);
|
|
if long(lSize).msw <> 0 then begin
|
|
|
|
{handle inc/dec of >64K}
|
|
LoadScalar(tree^.id);
|
|
GenLdcLong(lSize);
|
|
if pc_l in [pc_lli,pc_lil] then
|
|
Gen0(pc_adl)
|
|
else
|
|
Gen0(pc_sbl);
|
|
with tree^.id^ do
|
|
case storage of
|
|
stackFrame, parameter:
|
|
Gen2t(pc_cop, lln, 0, cgULong);
|
|
external, global, private:
|
|
Gen1tName(pc_cpo, 0, cgULong, name);
|
|
otherwise: ;
|
|
end; {case}
|
|
if pc_l in [pc_lli,pc_lld] then begin
|
|
GenLdcLong(lSize);
|
|
if pc_l = pc_lld then
|
|
Gen0(pc_adl)
|
|
else
|
|
Gen0(pc_sbl);
|
|
end; {if}
|
|
goto 1;
|
|
end; {if}
|
|
baseType := cgULong;
|
|
iSize := long(lSize).lsw;
|
|
end; {else}
|
|
case storage of
|
|
stackFrame, parameter:
|
|
Gen2t(pc_l, lln, iSize, baseType);
|
|
external, global, private:
|
|
Gen2tName(pc_g, iSize, 0, baseType, name);
|
|
otherwise: ;
|
|
end; {case}
|
|
expressionType := itype;
|
|
end {with}
|
|
else begin
|
|
|
|
{do an indirect ++ or --}
|
|
LoadAddress(tree); {get the address to save to}
|
|
if expressionType^.kind = arrayType then
|
|
expressionType := expressionType^.aType
|
|
else if expressionType^.kind = pointerType then
|
|
expressionType := expressionType^.pType;
|
|
if expressionType^.kind = scalarType then
|
|
if expressionType^.baseType in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgReal,cgDouble,cgComp,cgExtended] then
|
|
tp := expressionType^.baseType
|
|
else
|
|
tp := UsualUnaryConversions
|
|
else
|
|
tp := UsualUnaryConversions;
|
|
if (tp in [cgByte,cgUByte,cgWord,cgUword])
|
|
and (expressionType^.cType <> ctBool)
|
|
and not isBitField then
|
|
Gen0t(pc_i, tp) {do indirect inc/dec}
|
|
else begin
|
|
t1 := GetTemp(cgLongSize);
|
|
Gen2t(pc_str, t1, 0, cgULong);
|
|
Gen2t(pc_lod, t1, 0, cgULong);
|
|
Gen2t(pc_lod, t1, 0, cgULong);
|
|
FreeTemp(t1, cgLongSize);
|
|
{load the value}
|
|
if isBitField then begin
|
|
if unsigned then
|
|
Gen2t(pc_lbu, bitDisp, bitSize, tp)
|
|
else
|
|
Gen2t(pc_lbf, bitDisp, bitSize, tp);
|
|
end {if}
|
|
else
|
|
Gen1t(pc_ind, 0, tp);
|
|
if pc_l in [pc_lli,pc_lld] then
|
|
if expressionType^.cType = ctBool then begin
|
|
t1 := GetTemp(cgWordSize);
|
|
Gen2t(pc_cop, t1, 0, cgWord);
|
|
end; {if}
|
|
IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --}
|
|
if isBitField then {copy the value}
|
|
Gen2t(pc_cbf, bitDisp, bitSize, tp)
|
|
else
|
|
Gen0t(pc_cpi, tp);
|
|
Gen0t(pc_bno, tp);
|
|
if pc_l in [pc_lli,pc_lld] then {correct the value for postfix ops}
|
|
if expressionType^.cType = ctBool then begin
|
|
Gen0t(pc_pop, cgWord);
|
|
Gen2t(pc_lod, t1, 0, cgWord);
|
|
Gen0t(pc_bno, cgWord);
|
|
FreeTemp(t1, cgWordSize);
|
|
end {if}
|
|
else
|
|
IncOrDec(pc_l = pc_lld);
|
|
end; {else}
|
|
end; {else}
|
|
1:
|
|
end; {DoIncDec}
|
|
|
|
|
|
procedure FunctionCall (tree: tokenPtr);
|
|
|
|
{ generate the actual function call }
|
|
|
|
var
|
|
fName: stringPtr; {uppercase file name}
|
|
fntype: typePtr; {temp function type}
|
|
ftree: tokenPtr; {function address tree}
|
|
ftype: typePtr; {function type}
|
|
i: integer; {loop variable}
|
|
indirect: boolean; {is this an indirect call?}
|
|
ldoDispose: boolean; {local copy of doDispose}
|
|
lcodeGeneration: boolean; {local copy of codeGeneration}
|
|
|
|
|
|
procedure FunctionParms (parms: tokenPtr; fType: typePtr);
|
|
|
|
{ Generate a function call. }
|
|
{ }
|
|
{ parameters: }
|
|
{ parms - parameter list }
|
|
{ fType - function type }
|
|
|
|
var
|
|
kind: typeKind; {for expression kinds}
|
|
ldoDispose: boolean; {local copy of doDispose}
|
|
lnumErrors: integer; {number of errors before type check}
|
|
numParms: integer; {# of parameters generated}
|
|
parameters: parameterPtr; {next prototyped parameter}
|
|
pCount: integer; {# of parameters prototyped}
|
|
prototype: boolean; {is the function prototyped?}
|
|
tp: tokenPtr; {work pointers}
|
|
fp, tfp: fmtArgPtr;
|
|
fmt: fmt_type;
|
|
|
|
|
|
procedure Reverse;
|
|
|
|
{ Reverse the parameter list }
|
|
|
|
var
|
|
p1,p2,p3: tokenPtr; {work pointers}
|
|
|
|
begin {Reverse}
|
|
p3 := parms; {remove the last entry}
|
|
p1 := parms;
|
|
p2 := nil;
|
|
while p3^.right <> nil do begin
|
|
p2 := p3;
|
|
p3 := p3^.right;
|
|
end; {while}
|
|
if p2 <> nil then
|
|
p2^.right := nil
|
|
else
|
|
p1 := nil;
|
|
while p1 <> nil do begin {reverse the remaining parms}
|
|
p2 := p1;
|
|
p1 := p1^.right;
|
|
p2^.right := p3;
|
|
p3 := p2;
|
|
end; {while}
|
|
parms := p3;
|
|
end; {Reverse}
|
|
|
|
|
|
begin {FunctionParms}
|
|
{check the validity of the parameter list}
|
|
if ftype^.isPascal then {reverse parms for pascal calls}
|
|
Reverse;
|
|
tp := parms; {set up to check types}
|
|
prototype := ftype^.prototyped;
|
|
parameters := ftype^.parameterList;
|
|
pCount := 1;
|
|
fmt := fmt_none;
|
|
fp := nil;
|
|
|
|
if ((lint & lintPrintf) <> 0) and fType^.varargs and not indirect then
|
|
fmt := FormatClassify(ftree^.id^.name^);
|
|
|
|
while parameters <> nil do begin {count the prototypes}
|
|
pCount := pCount+1;
|
|
parameters := parameters^.next;
|
|
end; {while}
|
|
parameters := ftype^.parameterList;
|
|
if prototype then begin {check for wrong # of parms}
|
|
while tp <> nil do begin {count the parms}
|
|
pCount := pCount-1;
|
|
tp := tp^.right;
|
|
end; {while}
|
|
tp := parms;
|
|
if (pCount > 0) or ((pCount <> 0) and not ftype^.varargs) then
|
|
Error(85);
|
|
end; {if}
|
|
|
|
tp := parms;
|
|
|
|
{generate the parameters}
|
|
numParms := 0;
|
|
lDoDispose := doDispose;
|
|
doDispose := false;
|
|
while tp <> nil do begin
|
|
if tp^.middle <> nil then begin
|
|
lnumErrors := numErrors;
|
|
kind := ExpressionKind(tp^.middle);
|
|
if numErrors = lnumErrors then
|
|
if kind in [structType,unionType] then begin
|
|
GenerateCode(tp^.middle);
|
|
if expressionType^.size & $FFFF8000 <> 0 then
|
|
Error(61);
|
|
Gen1t(pc_ldc, long(expressionType^.size).lsw, cgWord);
|
|
Gen0(pc_psh);
|
|
end {else if}
|
|
else
|
|
GenerateCode(tp^.middle);
|
|
if fmt <> fmt_none then begin
|
|
new(tfp);
|
|
tfp^.next := fp;
|
|
tfp^.tk := tp^.middle;
|
|
tfp^.ty := expressionType;
|
|
fp := tfp;
|
|
end;
|
|
if prototype then begin
|
|
if pCount = 0 then begin
|
|
if parameters <> nil then begin
|
|
AssignmentConversion(parameters^.parameterType,
|
|
expressionType, lastWasConst, lastConst, true, false);
|
|
end; {if}
|
|
parameters := parameters^.next;
|
|
end {if}
|
|
else
|
|
pCount := pCount+1;
|
|
end; {if}
|
|
Gen0t(pc_stk, UsualUnaryConversions);
|
|
if numParms <> 0 then
|
|
Gen0t(pc_bno, UsualUnaryConversions);
|
|
numParms := numParms+1;
|
|
end; {if}
|
|
tp := tp^.right;
|
|
end; {while}
|
|
|
|
if fmt <> fmt_none then FormatCheck(fmt, fp);
|
|
|
|
|
|
doDispose := lDoDispose;
|
|
if numParms = 0 then
|
|
Gen0(pc_nop);
|
|
|
|
if ftype^.isPascal then {restore parm order}
|
|
Reverse;
|
|
|
|
if doDispose then begin {dispose of leaf nodes}
|
|
DisposeTree(parms^.middle);
|
|
DisposeTree(parms^.right);
|
|
end; {if}
|
|
end; {FunctionParms}
|
|
|
|
|
|
begin {FunctionCall}
|
|
{find the type of the function}
|
|
indirect := true; {assume an indirect call}
|
|
ftree := tree^.left; {get the function tree}
|
|
if ftree^.token.kind = ident then {check for direct calls}
|
|
if ftree^.id^.itype^.kind = functionType then begin
|
|
indirect := false;
|
|
fType := ftree^.id^.itype; {get the function type}
|
|
end; {if}
|
|
if indirect then begin {get type for indirect call}
|
|
ldoDispose := doDispose;
|
|
doDispose := false;
|
|
lcodeGeneration := codeGeneration;
|
|
codeGeneration := false;
|
|
GenerateCode(ftree);
|
|
doDispose := ldoDispose;
|
|
codeGeneration := lCodeGeneration and (numErrors = 0);
|
|
ftype := expressionType;
|
|
while ftype^.kind in [pointerType,arrayType] do
|
|
ftype := ftype^.ptype;
|
|
end; {if}
|
|
|
|
{make sure the identifier is really a function}
|
|
if ftype^.kind <> functionType then
|
|
Error(114)
|
|
else begin
|
|
|
|
{generate function parameters}
|
|
FunctionParms (tree, fType);
|
|
|
|
{generate the function call}
|
|
expressionType := ftype^.fType;
|
|
if expressionType^.kind in [structType,unionType] then
|
|
expressionType := uLongPtr;
|
|
if (ftype^.toolNum = 0) and (ftype^.dispatcher = 0) then begin
|
|
if indirect then begin
|
|
fntype := expressionType;
|
|
GenerateCode(ftree);
|
|
expressionType := fntype;
|
|
Gen1t(pc_cui, ord(fType^.varargs and strictVararg),
|
|
UsualUnaryConversions);
|
|
end {if}
|
|
else begin
|
|
fname := ftree^.id^.name;
|
|
if ftype^.isPascal then begin
|
|
fname := pointer(Malloc(length(fname^)+1));
|
|
CopyString(pointer(fname), pointer(ftree^.id^.name));
|
|
for i := 1 to length(fname^) do
|
|
if fName^[i] in ['a'..'z'] then
|
|
fName^[i] := chr(ord(fName^[i]) & $5F);
|
|
end; {if}
|
|
Gen1tName(pc_cup, ord(fType^.varargs and strictVararg),
|
|
UsualUnaryConversions, fname);
|
|
end; {else}
|
|
if fType^.varargs then
|
|
hasVarargsCall := true;
|
|
end {if}
|
|
else
|
|
GenTool(pc_tl1, ftype^.toolNum, long(ftype^.ftype^.size).lsw,
|
|
ftype^.dispatcher);
|
|
expressionType := ftype^.fType;
|
|
lastWasConst := false;
|
|
end; {else}
|
|
end; {FunctionCall}
|
|
|
|
|
|
procedure CompareCompatible (var t1,t2: typePtr);
|
|
|
|
{ Make sure that it is legal to compare t1 to t2 }
|
|
|
|
begin {CompareCompatible}
|
|
if (t1^.kind = functionType) or (t2^.kind = functionType) then begin
|
|
if not CompTypes(t1, t2) then
|
|
Error(47);
|
|
end {if}
|
|
else if t1^.kind in [pointerType,arrayType] then begin
|
|
if t2^.kind in [pointerType,arrayType] then begin
|
|
if (t1^.ptype = voidPtr) or (t2^.ptype = voidPtr) then
|
|
else if not CompTypes(t1^.ptype, t2^.ptype) then
|
|
Error(47);
|
|
t2 := ulongPtr;
|
|
end {if}
|
|
else if (not lastwasconst) or (lastconst <> 0) then
|
|
Error(47);
|
|
t1 := ulongPtr;
|
|
end {if}
|
|
else if expressionType^.kind in [pointerType,arrayType] then begin
|
|
if (not tlastwasconst) or (tlastconst <> 0) then
|
|
Error(47);
|
|
t2 := ulongPtr;
|
|
end; {else if}
|
|
end; {CompareCompatible}
|
|
|
|
|
|
procedure CheckDivByZero (var divisor: tokenType; opType: typePtr);
|
|
|
|
{ Check for division by (constant) zero. }
|
|
{ }
|
|
{ parameters: }
|
|
{ divisor - token for divisor }
|
|
{ opType - type of the result of the operation }
|
|
|
|
begin {CheckDivByZero}
|
|
if opType^.kind = scalarType then
|
|
if opType^.baseType in
|
|
[cgByte,cgWord,cgUByte,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
|
|
if ((divisor.class = intConstant) and (divisor.ival = 0))
|
|
or ((divisor.class = longConstant) and (divisor.lval = 0))
|
|
or ((divisor.class = longlongConstant)
|
|
and (divisor.qval.lo = 0) and (divisor.qval.hi = 0))
|
|
or ((divisor.class = doubleConstant) and (divisor.rval = 0.0)) then
|
|
Error(129);
|
|
end; {CheckDivByZero}
|
|
|
|
|
|
procedure CheckShiftOverflow (var shiftCountTok: tokenType; opType: typePtr);
|
|
|
|
{ Check for invalid (too large or negative) shift count. }
|
|
{ }
|
|
{ parameters: }
|
|
{ shiftCountTok - token for shift count }
|
|
{ opType - type of the result of the operation }
|
|
|
|
var
|
|
shiftCount: longint;
|
|
|
|
begin {CheckShiftOverflow}
|
|
if shiftCountTok.class = intConstant then
|
|
shiftCount := shiftCountTok.ival
|
|
else if shiftCountTok.class = longConstant then
|
|
shiftCount := shiftCountTok.lval
|
|
else if shiftCountTok.class = longlongConstant then begin
|
|
if shiftCountTok.qval.hi = 0 then
|
|
shiftCount := shiftCountTok.qval.lo
|
|
else
|
|
shiftCount := -1;
|
|
end {else if}
|
|
else
|
|
shiftCount := 0;
|
|
|
|
if (shiftCount <> 0) and (opType^.kind = scalarType) then begin
|
|
if opType^.baseType in [cgByte,cgWord,cgUByte,cgUWord] then
|
|
if (shiftCount < 0) or (shiftCount > 15) then
|
|
Error(130);
|
|
if opType^.baseType in [cgLong,cgULong] then
|
|
if (shiftCount < 0) or (shiftCount > 31) then
|
|
Error(130);
|
|
if opType^.baseType in [cgQuad,cgUQuad] then
|
|
if (shiftCount < 0) or (shiftCount > 63) then
|
|
Error(130);
|
|
end; {if}
|
|
end; {CheckShiftOverflow}
|
|
|
|
|
|
begin {GenerateCode}
|
|
lastwasconst := false;
|
|
case tree^.token.kind of
|
|
|
|
parameterOper:
|
|
FunctionCall(tree);
|
|
|
|
ident: begin
|
|
tType := tree^.id^.itype;
|
|
while tType^.kind = definedType do
|
|
tType := tType^.dType;
|
|
case tType^.kind of
|
|
|
|
scalarType: begin
|
|
LoadScalar(tree^.id);
|
|
expressionType := tree^.id^.itype;
|
|
end;
|
|
|
|
pointerType: begin
|
|
LoadScalar(tree^.id);
|
|
expressionType := tree^.id^.itype;
|
|
end;
|
|
|
|
|
|
arrayType: begin
|
|
LoadAddress(tree);
|
|
expressionType := expressionType^.ptype;
|
|
end;
|
|
|
|
functionType:
|
|
LoadAddress(tree);
|
|
|
|
structType, unionType: begin
|
|
LoadAddress(tree);
|
|
if expressionType^.kind = pointerType then
|
|
expressionType := expressionType^.ptype;
|
|
end;
|
|
|
|
enumConst: begin
|
|
Gen1t(pc_ldc, tree^.id^.itype^.eval, cgWord);
|
|
expressionType := intPtr;
|
|
end;
|
|
|
|
end; {case}
|
|
end;
|
|
|
|
intConst,uintConst: begin
|
|
Gen1t(pc_ldc, tree^.token.ival, cgWord);
|
|
lastwasconst := true;
|
|
lastconst := tree^.token.ival;
|
|
if tree^.token.kind = intConst then
|
|
expressionType := intPtr
|
|
else
|
|
expressionType := uIntPtr;
|
|
end; {case intConst}
|
|
|
|
longConst,ulongConst: begin
|
|
GenLdcLong(tree^.token.lval);
|
|
if tree^.token.kind = longConst then
|
|
expressionType := longPtr
|
|
else
|
|
expressionType := ulongPtr;
|
|
lastwasconst := true;
|
|
lastconst := tree^.token.lval;
|
|
end; {case longConst}
|
|
|
|
longlongConst,ulonglongConst: begin
|
|
GenLdcQuad(tree^.token.qval);
|
|
if tree^.token.kind = longlongConst then
|
|
expressionType := longlongPtr
|
|
else
|
|
expressionType := ulonglongPtr;
|
|
if (tree^.token.qval.hi = 0) and (tree^.token.qval.lo >= 0) then begin
|
|
lastwasconst := true;
|
|
lastconst := tree^.token.qval.lo;
|
|
end; {if}
|
|
end; {case longlongConst}
|
|
|
|
doubleConst: begin
|
|
GenLdcReal(tree^.token.rval);
|
|
expressionType := doublePtr;
|
|
end; {case doubleConst}
|
|
|
|
stringConst: begin
|
|
GenS(pc_lca, tree^.token.sval);
|
|
expressionType := stringTypePtr;
|
|
end; {case stringConst}
|
|
|
|
eqch: begin {=}
|
|
L_Value(tree^.left);
|
|
with tree^.left^ do begin
|
|
if token.kind = ident then
|
|
kind := id^.itype^.kind
|
|
else
|
|
kind := definedType;
|
|
if kind = arrayType then
|
|
if id^.storage = parameter then
|
|
kind := pointerType;
|
|
if (token.kind = ident)
|
|
and (kind in [scalarType,pointerType]) then begin
|
|
GenerateCode(tree^.right);
|
|
with tree^.left^.id^ do begin
|
|
if itype^.kind in [pointerType,arrayType] then
|
|
lType := uLongPtr
|
|
else
|
|
lType := itype;
|
|
AssignmentConversion(itype, expressionType, lastWasConst,
|
|
lastConst, true, true);
|
|
case storage of
|
|
stackFrame, parameter:
|
|
Gen2t(pc_cop, lln, 0, lType^.baseType);
|
|
external, global, private:
|
|
Gen1tName(pc_cpo, 0, lType^.baseType, name);
|
|
otherwise: ;
|
|
end; {case}
|
|
end; {with}
|
|
end {if}
|
|
else begin
|
|
LoadAddress(tree^.left);
|
|
lType := expressionType;
|
|
lisBitField := isBitField;
|
|
lbitDisp := bitDisp;
|
|
lbitSize := bitSize;
|
|
if lType^.kind = arrayType then
|
|
lType := lType^.aType
|
|
else if lType^.kind = pointerType then
|
|
lType := lType^.pType;
|
|
GenerateCode(tree^.right);
|
|
AssignmentConversion(lType, expressionType, lastWasConst,
|
|
lastConst, true, true);
|
|
case lType^.kind of
|
|
scalarType:
|
|
if lisBitField then
|
|
Gen2t(pc_cbf, lbitDisp, lbitSize, lType^.baseType)
|
|
else
|
|
Gen0t(pc_cpi, lType^.baseType);
|
|
|
|
pointerType:
|
|
Gen0t(pc_cpi, cgULong);
|
|
|
|
structType,unionType:
|
|
Gen2(pc_mov, long(lType^.size).msw, long(lType^.size).lsw);
|
|
|
|
otherwise:
|
|
Error(47);
|
|
|
|
end; {case}
|
|
end; {else}
|
|
end; {with}
|
|
end; {=}
|
|
|
|
pluseqop, {+=}
|
|
minuseqop, {-=}
|
|
asteriskeqop, {*=}
|
|
slasheqop, {/=}
|
|
percenteqop, {%=}
|
|
ltlteqop, {<<=}
|
|
gtgteqop, {>>=}
|
|
andeqop, {&=}
|
|
caroteqop, {^=}
|
|
bareqop: with tree^.left^ do {|=}
|
|
begin
|
|
L_Value(tree^.left);
|
|
if (token.kind = ident)
|
|
and ((id^.itype^.kind in [scalarType,pointerType])
|
|
or ((id^.itype^.kind = arrayType) and (id^.storage = parameter))) then begin
|
|
doingScalar := true;
|
|
LoadScalar(id);
|
|
lType := id^.itype;
|
|
t1 := 0;
|
|
end {if}
|
|
else begin
|
|
doingScalar := false;
|
|
LoadAddress(tree^.left);
|
|
lisBitField := isBitField;
|
|
lbitDisp := bitDisp;
|
|
lbitSize := bitSize;
|
|
t1 := GetTemp(cgLongSize);
|
|
Gen2t(pc_str, t1, 0, cgULong);
|
|
Gen2t(pc_lod, t1, 0, cgULong);
|
|
Gen2t(pc_lod, t1, 0, cgULong);
|
|
lType := expressionType^.pType;
|
|
if isBitField then begin
|
|
if unsigned then
|
|
Gen2t(pc_lbu, bitDisp, bitSize, lType^.baseType)
|
|
else
|
|
Gen2t(pc_lbf, bitDisp, bitSize, lType^.baseType);
|
|
end {if}
|
|
else if lType^.kind = pointerType then
|
|
Gen1t(pc_ind, 0, cgULong)
|
|
else
|
|
Gen1t(pc_ind, 0, lType^.baseType);
|
|
end; {else}
|
|
if lType^.isConstant then
|
|
Error(93);
|
|
if doingScalar
|
|
and (ltype^.kind = arrayType) and (id^.storage = parameter) then
|
|
kind := pointerType
|
|
else
|
|
kind := lType^.kind;
|
|
GenerateCode(tree^.right);
|
|
if expressionType^.kind <> scalarType then
|
|
Error(66);
|
|
if tree^.token.kind in [gtgteqop,ltlteqop] then
|
|
if kind = scalarType then
|
|
if expressionType^.kind = scalarType then begin
|
|
if expressionType^.baseType in
|
|
[cgReal,cgDouble,cgComp,cgExtended,cgVoid] then
|
|
Error(66);
|
|
et := UsualUnaryConversions;
|
|
if ltype^.baseType in [cgQuad,cgUQuad] then begin
|
|
if not (et in [cgWord,cgUWord]) then begin
|
|
Gen2(pc_cnv, et, ord(cgWord));
|
|
end; {if}
|
|
expressionType := lType;
|
|
end {if}
|
|
else
|
|
if et <> Unary(ltype^.baseType) then begin
|
|
Gen2(pc_cnv, et, ord(Unary(ltype^.baseType)));
|
|
expressionType := lType;
|
|
end; {if}
|
|
end; {if}
|
|
if kind <> pointerType then
|
|
et := UsualBinaryConversions(lType)
|
|
else
|
|
et := ccPointer;
|
|
case tree^.token.kind of
|
|
|
|
pluseqop:
|
|
if kind = pointerType then begin
|
|
ChangePointer(pc_adl, lType^.pType^.size, UsualUnaryConversions);
|
|
expressionType := lType;
|
|
end
|
|
else if et in [cgWord,cgUWord] then
|
|
Gen0(pc_adi)
|
|
else if et in [cgLong,cgULong] then
|
|
Gen0(pc_adl)
|
|
else if et in [cgQuad,cgUQuad] then
|
|
Gen0(pc_adq)
|
|
else if et = cgExtended then
|
|
Gen0(pc_adr)
|
|
else
|
|
Error(66);
|
|
|
|
minuseqop:
|
|
if kind = pointerType then begin
|
|
ChangePointer(pc_sbl, lType^.pType^.size, UsualUnaryConversions);
|
|
expressionType := lType;
|
|
end
|
|
else if et in [cgWord,cgUWord] then
|
|
Gen0(pc_sbi)
|
|
else if et in [cgLong,cgULong] then
|
|
Gen0(pc_sbl)
|
|
else if et in [cgQuad,cgUQuad] then
|
|
Gen0(pc_sbq)
|
|
else if et = cgExtended then
|
|
Gen0(pc_sbr)
|
|
else
|
|
Error(66);
|
|
|
|
asteriskeqop:
|
|
if et = cgWord then
|
|
Gen0(pc_mpi)
|
|
else if et = cgUWord then
|
|
Gen0(pc_umi)
|
|
else if et = cgLong then
|
|
Gen0(pc_mpl)
|
|
else if et = cgULong then
|
|
Gen0(pc_uml)
|
|
else if et = cgQuad then
|
|
Gen0(pc_mpq)
|
|
else if et = cgUQuad then
|
|
Gen0(pc_umq)
|
|
else if et = cgExtended then
|
|
Gen0(pc_mpr)
|
|
else
|
|
Error(66);
|
|
|
|
slasheqop:
|
|
if et = cgWord then
|
|
Gen0(pc_dvi)
|
|
else if et = cgUWord then
|
|
Gen0(pc_udi)
|
|
else if et = cgLong then
|
|
Gen0(pc_dvl)
|
|
else if et = cgULong then
|
|
Gen0(pc_udl)
|
|
else if et = cgQuad then
|
|
Gen0(pc_dvq)
|
|
else if et = cgUQuad then
|
|
Gen0(pc_udq)
|
|
else if et = cgExtended then
|
|
Gen0(pc_dvr)
|
|
else
|
|
Error(66);
|
|
|
|
percenteqop:
|
|
if et = cgWord then
|
|
Gen0(pc_mod)
|
|
else if et = cgUWord then
|
|
Gen0(pc_uim)
|
|
else if et = cgLong then
|
|
Gen0(pc_mdl)
|
|
else if et = cgULong then
|
|
Gen0(pc_ulm)
|
|
else if et = cgQuad then
|
|
Gen0(pc_mdq)
|
|
else if et = cgUQuad then
|
|
Gen0(pc_uqm)
|
|
else
|
|
Error(66);
|
|
|
|
ltlteqop:
|
|
if et in [cgWord,cgUWord] then
|
|
Gen0(pc_shl)
|
|
else if et in [cgLong,cgULong] then
|
|
Gen0(pc_sll)
|
|
else if et in [cgQuad,cgUQuad] then
|
|
Gen0(pc_slq)
|
|
else
|
|
Error(66);
|
|
|
|
gtgteqop:
|
|
if et = cgWord then
|
|
Gen0(pc_shr)
|
|
else if et = cgUWord then
|
|
Gen0(pc_usr)
|
|
else if et = cgLong then
|
|
Gen0(pc_slr)
|
|
else if et = cgULong then
|
|
Gen0(pc_vsr)
|
|
else if et = cgQuad then
|
|
Gen0(pc_sqr)
|
|
else if et = cgUQuad then
|
|
Gen0(pc_wsr)
|
|
else
|
|
Error(66);
|
|
|
|
andeqop:
|
|
if et in [cgWord,cgUWord] then
|
|
Gen0(pc_bnd)
|
|
else if et in [cgLong,cgULong] then
|
|
Gen0(pc_bal)
|
|
else if et in [cgQuad,cgUQuad] then
|
|
Gen0(pc_baq)
|
|
else
|
|
Error(66);
|
|
|
|
caroteqop:
|
|
if et in [cgWord,cgUWord] then
|
|
Gen0(pc_bxr)
|
|
else if et in [cgLong,cgULong] then
|
|
Gen0(pc_blx)
|
|
else if et in [cgQuad,cgUQuad] then
|
|
Gen0(pc_bqx)
|
|
else
|
|
Error(66);
|
|
|
|
bareqop:
|
|
if et in [cgWord,cgUWord] then
|
|
Gen0(pc_bor)
|
|
else if et in [cgLong,cgULong] then
|
|
Gen0(pc_blr)
|
|
else if et in [cgQuad,cgUQuad] then
|
|
Gen0(pc_bqr)
|
|
else
|
|
Error(66);
|
|
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
if ((lint & lintOverflow) <> 0) then begin
|
|
if tree^.token.kind in [slasheqop,percenteqop] then
|
|
CheckDivByZero(tree^.right^.token, lType)
|
|
else if tree^.token.kind in [ltlteqop,gtgteqop] then
|
|
CheckShiftOverflow(tree^.right^.token, lType);
|
|
end; {if}
|
|
AssignmentConversion(lType,expressionType,false,0,true,true);
|
|
if doingScalar then begin
|
|
if kind = pointerType then
|
|
lType := uLongPtr;
|
|
case id^.storage of
|
|
stackFrame, parameter:
|
|
Gen2t(pc_cop, id^.lln, 0, lType^.baseType);
|
|
external, global, private:
|
|
Gen1tName(pc_cpo, 0, lType^.baseType, id^.name);
|
|
otherwise: ;
|
|
end; {case}
|
|
end {if}
|
|
else begin
|
|
if lisBitField then
|
|
Gen2t(pc_cbf, lbitDisp, lbitSize, lType^.baseType)
|
|
else begin
|
|
if ltype^.kind in [pointerType,arrayType] then
|
|
lType := uLongPtr;
|
|
Gen0t(pc_cpi, lType^.baseType);
|
|
end; {else}
|
|
Gen0t(pc_bno, lType^.baseType);
|
|
end; {else}
|
|
if t1 <> 0 then
|
|
FreeTemp(t1, cgLongSize);
|
|
end; {with}
|
|
|
|
commach: begin {,}
|
|
GenerateCode(tree^.left);
|
|
if expressionType^.baseType <> cgVoid then
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
GenerateCode(tree^.right);
|
|
Gen0t(pc_bno, UsualUnaryConversions);
|
|
{result type is already in expressionType}
|
|
end; {case commach}
|
|
|
|
barbarop: begin {||}
|
|
GenerateCode(tree^.left);
|
|
if expressionType^.kind in [pointerType,arrayType] then
|
|
expressionType := uLongPtr
|
|
else begin
|
|
et := UsualUnaryConversions;
|
|
if et = cgExtended then begin
|
|
GenLdcReal(0.0);
|
|
Gen0t(pc_neq, cgExtended);
|
|
expressionType := intPtr;
|
|
end {if}
|
|
else if et in [cgQuad,cgUQuad] then begin
|
|
GenLdcQuad(longlong0);
|
|
Gen0t(pc_neq, et);
|
|
expressionType := intPtr;
|
|
end; {else if}
|
|
end; {else}
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if expressionType^.kind in [pointerType,arrayType] then
|
|
expressionType := uLongPtr
|
|
else begin
|
|
et := UsualUnaryConversions;
|
|
if et = cgExtended then begin
|
|
GenLdcReal(0.0);
|
|
Gen0t(pc_neq, cgExtended);
|
|
expressionType := intPtr;
|
|
end {if}
|
|
else if et in [cgQuad,cgUQuad] then begin
|
|
GenLdcQuad(longlong0);
|
|
Gen0t(pc_neq, et);
|
|
expressionType := intPtr;
|
|
end; {else if}
|
|
end; {else}
|
|
case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_ior);
|
|
cgLong,cgULong:
|
|
Gen0(pc_lor);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
expressionType := intPtr;
|
|
end; {case barbarop}
|
|
|
|
andandop: begin {&&}
|
|
GenerateCode(tree^.left);
|
|
if expressionType^.kind in [pointerType,arrayType] then
|
|
expressionType := uLongPtr
|
|
else begin
|
|
et := UsualUnaryConversions;
|
|
if et = cgExtended then begin
|
|
GenLdcReal(0.0);
|
|
Gen0t(pc_neq, cgExtended);
|
|
expressionType := intPtr;
|
|
end {if}
|
|
else if et in [cgQuad,cgUQuad] then begin
|
|
GenLdcQuad(longlong0);
|
|
Gen0t(pc_neq, et);
|
|
expressionType := intPtr;
|
|
end; {else if}
|
|
end; {else}
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if expressionType^.kind in [pointerType,arrayType] then
|
|
expressionType := uLongPtr
|
|
else begin
|
|
et := UsualUnaryConversions;
|
|
if et = cgExtended then begin
|
|
GenLdcReal(0.0);
|
|
Gen0t(pc_neq, cgExtended);
|
|
expressionType := intPtr;
|
|
end {if}
|
|
else if et in [cgQuad,cgUQuad] then begin
|
|
GenLdcQuad(longlong0);
|
|
Gen0t(pc_neq, et);
|
|
expressionType := intPtr;
|
|
end; {else if}
|
|
end; {else}
|
|
case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_and);
|
|
cgLong,cgULong:
|
|
Gen0(pc_lnd);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
expressionType := intPtr;
|
|
end; {case andandop}
|
|
|
|
carotch: begin {^}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (lType^.kind <> scalarType) or (expressionType^.kind <> scalarType) then
|
|
Error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_bxr);
|
|
cgLong,cgULong:
|
|
Gen0(pc_blx);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_bqx);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {case carotch}
|
|
|
|
barch: begin {|}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (lType^.kind <> scalarType) or (expressionType^.kind <> scalarType) then
|
|
Error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_bor);
|
|
cgLong,cgULong:
|
|
Gen0(pc_blr);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_bqr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {case barch}
|
|
|
|
andch: begin {&}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (lType^.kind <> scalarType) or (expressionType^.kind <> scalarType) then
|
|
Error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_bnd);
|
|
cgLong,cgULong:
|
|
Gen0(pc_bal);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_baq);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {case andch}
|
|
|
|
ltltop: begin {<<}
|
|
GenerateCode(tree^.left);
|
|
if (expressionType^.kind <> scalarType) then
|
|
error(66);
|
|
et := UsualUnaryConversions;
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (expressionType^.kind <> scalarType)
|
|
or not (expressionType^.baseType in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]) then
|
|
error(66);
|
|
if et in [cgQuad,cgUQuad] then begin
|
|
if not (expressionType^.baseType in [cgWord,cgUWord]) then
|
|
Gen2(pc_cnv, ord(expressionType^.baseType), ord(cgWord));
|
|
end {if}
|
|
else
|
|
if expressionType^.baseType <> et then
|
|
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
|
|
case et of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_shl);
|
|
cgLong,cgULong:
|
|
Gen0(pc_sll);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_slq);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
expressionType := lType;
|
|
if ((lint & lintOverflow) <> 0) then
|
|
CheckShiftOverflow(tree^.right^.token, expressionType);
|
|
end; {case ltltop}
|
|
|
|
gtgtop: begin {>>}
|
|
GenerateCode(tree^.left);
|
|
if (expressionType^.kind <> scalarType) then
|
|
error(66);
|
|
et := UsualUnaryConversions;
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (expressionType^.kind <> scalarType)
|
|
or not (expressionType^.baseType in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]) then
|
|
error(66);
|
|
if et in [cgQuad,cgUQuad] then begin
|
|
if not (expressionType^.baseType in [cgWord,cgUWord]) then
|
|
Gen2(pc_cnv, ord(expressionType^.baseType), ord(cgWord));
|
|
end {if}
|
|
else
|
|
if expressionType^.baseType <> et then
|
|
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
|
|
case et of
|
|
cgByte,cgWord:
|
|
Gen0(pc_shr);
|
|
cgUByte,cgUWord:
|
|
Gen0(pc_usr);
|
|
cgLong:
|
|
Gen0(pc_slr);
|
|
cgULong:
|
|
Gen0(pc_vsr);
|
|
cgQuad:
|
|
Gen0(pc_sqr);
|
|
cgUQuad:
|
|
Gen0(pc_wsr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
expressionType := lType;
|
|
if ((lint & lintOverflow) <> 0) then
|
|
CheckShiftOverflow(tree^.right^.token, expressionType);
|
|
end; {case gtgtop}
|
|
|
|
plusch: begin {+}
|
|
if ExpressionKind(tree^.right) in [arrayType,pointerType] then begin
|
|
tree^.middle := tree^.right;
|
|
tree^.right := tree^.left;
|
|
tree^.left := tree^.middle;
|
|
end; {if}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if lType^.kind in [arrayType,pointerType] then begin
|
|
if expressionType^.kind <> scalarType then
|
|
error(66);
|
|
|
|
{pointer addition}
|
|
et := UsualUnaryConversions;
|
|
expressionType := lType;
|
|
if lType^.kind = arrayType then
|
|
lType := lType^.aType
|
|
else
|
|
lType := lType^.pType;
|
|
ChangePointer(pc_adl, lType^.size, et);
|
|
if expressionType^.kind = arrayType then begin
|
|
tType := pointer(Malloc(sizeof(typeRecord)));
|
|
tType^.size := cgLongSize;
|
|
tType^.saveDisp := 0;
|
|
tType^.isConstant := false;
|
|
tType^.kind := pointerType;
|
|
tType^.pType := expressionType^.aType;
|
|
expressionType := tType;
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
|
|
{scalar addition}
|
|
case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_adi);
|
|
cgLong,cgULong:
|
|
Gen0(pc_adl);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_adq);
|
|
cgExtended:
|
|
Gen0(pc_adr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {else}
|
|
end; {case plusch}
|
|
|
|
minusch: begin {-}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if lType^.kind in [pointerType,arrayType] then begin
|
|
if lType^.kind = arrayType then
|
|
size := lType^.aType^.size
|
|
else
|
|
size := lType^.pType^.size;
|
|
if expressionType^.kind in [arrayType,pointerType] then begin
|
|
|
|
{subtraction of two pointers}
|
|
if size = 0 then
|
|
Error(122)
|
|
{NOTE: assumes aType & pType overlap in typeRecord}
|
|
else if not CompTypes(lType^.aType, expressionType^.aType) then
|
|
Error(47);
|
|
Gen0(pc_sbl);
|
|
if size <> 1 then begin
|
|
GenLdcLong(size);
|
|
Gen0(pc_dvl);
|
|
end; {if}
|
|
lType := longPtr;
|
|
end {if}
|
|
else
|
|
{subtract a scalar from a pointer}
|
|
ChangePointer(pc_sbl, size, UsualUnaryConversions);
|
|
expressionType := lType;
|
|
if expressionType^.kind = arrayType then begin
|
|
tType := pointer(Malloc(sizeof(typeRecord)));
|
|
tType^.size := cgLongSize;
|
|
tType^.saveDisp := 0;
|
|
tType^.isConstant := false;
|
|
tType^.kind := pointerType;
|
|
tType^.pType := expressionType^.aType;
|
|
expressionType := tType;
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
|
|
{scalar subtraction}
|
|
if expressionType^.kind <> scalarType then
|
|
error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_sbi);
|
|
cgLong,cgULong:
|
|
Gen0(pc_sbl);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_sbq);
|
|
cgExtended:
|
|
Gen0(pc_sbr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {else}
|
|
end; {case minusch}
|
|
|
|
asteriskch: begin {*}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (lType^.kind <> scalarType) or (expressionType^.kind <> scalarType) then
|
|
Error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgWord:
|
|
Gen0(pc_mpi);
|
|
cgUByte,cgUWord:
|
|
Gen0(pc_umi);
|
|
cgLong:
|
|
Gen0(pc_mpl);
|
|
cgULong:
|
|
Gen0(pc_uml);
|
|
cgQuad:
|
|
Gen0(pc_mpq);
|
|
cgUQuad:
|
|
Gen0(pc_umq);
|
|
cgExtended:
|
|
Gen0(pc_mpr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {case asteriskch}
|
|
|
|
slashch: begin {/}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (lType^.kind <> scalarType) or (expressionType^.kind <> scalarType) then
|
|
Error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgWord:
|
|
Gen0(pc_dvi);
|
|
cgUByte,cgUWord:
|
|
Gen0(pc_udi);
|
|
cgLong:
|
|
Gen0(pc_dvl);
|
|
cgULong:
|
|
Gen0(pc_udl);
|
|
cgQuad:
|
|
Gen0(pc_dvq);
|
|
cgUQuad:
|
|
Gen0(pc_udq);
|
|
cgExtended:
|
|
Gen0(pc_dvr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
if ((lint & lintOverflow) <> 0) then
|
|
CheckDivByZero(tree^.right^.token, expressionType);
|
|
end; {case slashch}
|
|
|
|
percentch: begin {%}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
if (lType^.kind <> scalarType) or (expressionType^.kind <> scalarType) then
|
|
Error(66)
|
|
else case UsualBinaryConversions(lType) of
|
|
cgByte,cgWord:
|
|
Gen0(pc_mod);
|
|
cgUByte,cgUWord:
|
|
Gen0(pc_uim);
|
|
cgLong:
|
|
Gen0(pc_mdl);
|
|
cgULong:
|
|
Gen0(pc_ulm);
|
|
cgQuad:
|
|
Gen0(pc_mdq);
|
|
cgUQuad:
|
|
Gen0(pc_uqm);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
if ((lint & lintOverflow) <> 0) then
|
|
CheckDivByZero(tree^.right^.token, expressionType);
|
|
end; {case percentch}
|
|
|
|
eqeqop, {==}
|
|
exceqop: begin {!=}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
tlastwasconst := lastwasconst;
|
|
tlastconst := lastconst;
|
|
GenerateCode(tree^.right);
|
|
CompareCompatible(ltype, expressionType);
|
|
if tree^.token.kind = eqeqop then
|
|
Gen0t(pc_equ, UsualBinaryConversions(lType))
|
|
else
|
|
Gen0t(pc_neq, UsualBinaryConversions(lType));
|
|
expressionType := intPtr;
|
|
end; {case exceqop,eqeqop}
|
|
|
|
lteqop, {<=}
|
|
gteqop, {>=}
|
|
ltch, {<}
|
|
gtch: begin {>}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
GenerateCode(tree^.right);
|
|
CompareCompatible(ltype, expressionType);
|
|
if tree^.token.kind = lteqop then
|
|
Gen0t(pc_leq, UsualBinaryConversions(lType))
|
|
else if tree^.token.kind = gteqop then
|
|
Gen0t(pc_geq, UsualBinaryConversions(lType))
|
|
else if tree^.token.kind = ltch then
|
|
Gen0t(pc_les, UsualBinaryConversions(lType))
|
|
else {if tree^.token.kind = gtch then}
|
|
Gen0t(pc_grt, UsualBinaryConversions(lType));
|
|
expressionType := intPtr;
|
|
end; {case lteqop,gteqop,ltch,gtch}
|
|
|
|
uminus: begin {unary -}
|
|
GenerateCode(tree^.left);
|
|
if expressionType^.kind <> scalarType then
|
|
error(66)
|
|
else case UsualUnaryConversions of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_ngi);
|
|
cgLong,cgULong:
|
|
Gen0(pc_ngl);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_ngq);
|
|
cgExtended:
|
|
Gen0(pc_ngr);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {case uminus}
|
|
|
|
tildech: begin {~}
|
|
GenerateCode(tree^.left);
|
|
if expressionType^.kind <> scalarType then
|
|
error(66)
|
|
else case UsualUnaryConversions of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_bnt);
|
|
cgLong,cgULong:
|
|
Gen0(pc_bnl);
|
|
cgQuad,cgUQuad:
|
|
Gen0(pc_bnq);
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
end; {case tildech}
|
|
|
|
excch: begin {!}
|
|
GenerateCode(tree^.left);
|
|
if expressionType^.kind = pointerType then
|
|
expressionType := uLongPtr;
|
|
case UsualUnaryConversions of
|
|
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
Gen0(pc_not);
|
|
|
|
cgLong,cgULong: begin
|
|
GenLdcLong(0);
|
|
Gen0t(pc_equ, cgLong);
|
|
end;
|
|
|
|
cgQuad,cgUQuad: begin
|
|
GenLdcQuad(longlong0);
|
|
Gen0t(pc_equ, cgQuad);
|
|
end;
|
|
|
|
cgExtended: begin
|
|
GenLdcReal(0.0);
|
|
Gen0t(pc_equ, cgExtended);
|
|
end;
|
|
|
|
otherwise:
|
|
error(66);
|
|
end; {case}
|
|
expressionType := intPtr;
|
|
end; {case excch}
|
|
|
|
plusplusop: {prefix ++}
|
|
DoIncDec(tree^.left, pc_lil, pc_gil, pc_iil);
|
|
|
|
opplusplus: {postfix ++}
|
|
DoIncDec(tree^.left, pc_lli, pc_gli, pc_ili);
|
|
|
|
minusminusop: {prefix --}
|
|
DoIncDec(tree^.left, pc_ldl, pc_gdl, pc_idl);
|
|
|
|
opminusminus: {postfix --}
|
|
DoIncDec(tree^.left, pc_lld, pc_gld, pc_ild);
|
|
|
|
uand: {unary & (address operator)}
|
|
LoadAddress(tree^.left);
|
|
|
|
uasterisk: begin {unary * (indirection)}
|
|
GenerateCode(tree^.left);
|
|
lType := expressionType;
|
|
if lType^.kind in [functiontype,arrayType,pointerType] then begin
|
|
if lType^.kind = arrayType then
|
|
lType := lType^.aType
|
|
else if lType^.kind = pointerType then
|
|
lType := lType^.pType;
|
|
expressionType := lType;
|
|
if lType^.kind = scalarType then
|
|
if lType^.baseType = cgVoid then
|
|
Gen1t(pc_ind, 0, cgULong)
|
|
else
|
|
Gen1t(pc_ind, 0, lType^.baseType)
|
|
else if lType^.kind = pointerType then
|
|
Gen1t(pc_ind, 0, cgULong)
|
|
else if not
|
|
((lType^.kind in [functionType,arrayType,structType,unionType])
|
|
or ((lType^.kind = definedType) and {handle const struct/union}
|
|
(lType^.dType^.kind in [structType,unionType]))) then
|
|
Error(79);
|
|
end {if}
|
|
else
|
|
Error(79);
|
|
end; {case uasterisk}
|
|
|
|
dotch: begin {.}
|
|
LoadAddress(tree^.left);
|
|
lType := expressionType;
|
|
if lType^.kind in [arrayType,pointerType] then begin
|
|
if lType^.kind = arrayType then
|
|
lType := lType^.aType
|
|
else if lType^.kind = pointerType then
|
|
lType := lType^.pType;
|
|
DoSelection(lType, tree^.right, size);
|
|
if (size & $00007FFF) <> size then begin
|
|
GenLdcLong(size);
|
|
Gen0(pc_adl);
|
|
size := 0;
|
|
end; {else}
|
|
kind := expressionType^.kind;
|
|
if kind = scalarType then begin
|
|
et := expressionType^.baseType;
|
|
if isBitField then begin
|
|
GenLdcLong(size);
|
|
Gen0(pc_adl);
|
|
if unsigned then
|
|
Gen2t(pc_lbu, bitDisp, bitSize, et)
|
|
else
|
|
Gen2t(pc_lbf, bitDisp, bitSize, et);
|
|
end {if}
|
|
else
|
|
Gen1t(pc_ind, long(size).lsw, et);
|
|
end {if}
|
|
else if kind = pointerType then
|
|
Gen1t(pc_ind, long(size).lsw, cgULong)
|
|
else if kind = enumType then
|
|
Gen1t(pc_ind, long(size).lsw, cgWord)
|
|
else if size <> 0 then
|
|
Gen1t(pc_inc, long(size).lsw, cgULong);
|
|
end {if}
|
|
else
|
|
Error(79);
|
|
end; {case dotch}
|
|
|
|
colonch: begin {? :}
|
|
GenerateCode(tree^.left); {evaluate the condition}
|
|
CompareToZero(pc_neq);
|
|
GenerateCode(tree^.middle); {evaluate true expression}
|
|
lType := expressionType;
|
|
tlastwasconst := lastwasconst;
|
|
tlastconst := lastconst;
|
|
GenerateCode(tree^.right); {evaluate false expression}
|
|
isString := false; {handle string operands}
|
|
if lType^.kind in [arrayType,pointerType] then
|
|
if lType^.aType^.baseType = cgUByte then begin
|
|
with expressionType^ do
|
|
if kind in [arrayType,pointerType] then begin
|
|
if aType^.baseType = cgUByte then
|
|
isString := true
|
|
else if (kind = pointerType)
|
|
and (CompTypes(lType,expressionType)) then
|
|
{it's all OK}
|
|
else
|
|
Error(47)
|
|
end {if}
|
|
else if (kind = scalarType)
|
|
and lastWasConst
|
|
and (lastConst = 0) then
|
|
et := UsualBinaryConversions(lType)
|
|
{it's all OK}
|
|
else
|
|
Error(47);
|
|
lType := voidPtrPtr;
|
|
expressionType := voidPtrPtr;
|
|
end; {if}
|
|
with expressionType^ do
|
|
if kind in [arrayType,pointerType] then
|
|
if aType^.baseType in [cgByte,cgUByte] then begin
|
|
if kind = pointerType then begin
|
|
if tlastwasconst and (tlastconst = 0) then
|
|
{it's all OK}
|
|
else if CompTypes(lType, expressionType) then
|
|
{it's all OK}
|
|
else
|
|
Error(47);
|
|
end {if}
|
|
else
|
|
Error(47);
|
|
et := UsualBinaryConversions(lType);
|
|
lType := voidPtrPtr;
|
|
expressionType := voidPtrPtr;
|
|
end; {if}
|
|
{generate the operation}
|
|
if lType^.kind in [structType, unionType, arrayType] then begin
|
|
if not CompTypes(lType, expressionType) then
|
|
Error(47);
|
|
Gen0(pc_bno);
|
|
Gen0t(pc_tri, cgULong);
|
|
end {if}
|
|
else begin
|
|
if expressionType^.kind = pointerType then
|
|
tType := expressionType
|
|
else
|
|
tType := lType;
|
|
if (expressionType^.kind = scalarType)
|
|
and (expressionType^.baseType = cgVoid)
|
|
and (lType^.kind = scalarType)
|
|
and (lType^.baseType = cgVoid) then
|
|
et := cgVoid
|
|
else
|
|
et := UsualBinaryConversions(lType);
|
|
Gen0(pc_bno);
|
|
Gen0t(pc_tri, et);
|
|
end; {else}
|
|
if isString then {set the type for strings}
|
|
expressionType := stringTypePtr;
|
|
end; {case colonch}
|
|
|
|
castoper: begin {(cast)}
|
|
GenerateCode(tree^.left);
|
|
Cast(tree^.castType);
|
|
end; {case castoper}
|
|
|
|
otherwise:
|
|
Error(57);
|
|
|
|
end; {case}
|
|
if doDispose then
|
|
dispose(tree);
|
|
end; {GenerateCode}
|
|
|
|
|
|
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 expression }
|
|
|
|
label 1;
|
|
|
|
var
|
|
lcodeGeneration: boolean; {local copy of codeGeneration}
|
|
ldoDispose: boolean; {local copy of doDispose}
|
|
tree: tokenPtr; {expression tree}
|
|
castValue: tokenPtr; {element being type cast}
|
|
|
|
begin {Expression}
|
|
errorFound := false; {no error so far}
|
|
tree := ExpressionTree(kind, stopSym); {create the expression tree}
|
|
if kind = normalExpression then begin {generate code from the expression tree}
|
|
if not errorFound then begin
|
|
doDispose := true;
|
|
GenerateCode(tree);
|
|
end {if}
|
|
else
|
|
expressionType := intPtr; {set default type in case of error}
|
|
end {if}
|
|
else begin {record the expression for an initializer}
|
|
initializerTree := tree;
|
|
isConstant := false;
|
|
llExpressionValue.lo := 0;
|
|
llExpressionValue.hi := 0;
|
|
expressionIsLongLong := false;
|
|
if errorFound then begin
|
|
DisposeTree(initializerTree);
|
|
initializerTree := nil;
|
|
expressionType := intPtr; {set default type in case of error}
|
|
end {if}
|
|
else begin
|
|
ldoDispose := doDispose; {find the expression type}
|
|
doDispose := false;
|
|
lcodeGeneration := codeGeneration;
|
|
codeGeneration := false;
|
|
GenerateCode(tree);
|
|
doDispose := ldoDispose;
|
|
codeGeneration := lCodeGeneration and (numErrors = 0);
|
|
{record the expression}
|
|
if tree^.token.kind = castoper then begin
|
|
castValue := tree^.left;
|
|
while castValue^.token.kind = castoper do
|
|
castValue := castValue^.left;
|
|
if castValue^.token.kind in [intconst,uintconst] then begin
|
|
expressionValue := castValue^.token.ival;
|
|
isConstant := true;
|
|
expressionType := tree^.castType;
|
|
if (castValue^.token.kind = uintconst)
|
|
or (expressionType^.kind = pointerType) then
|
|
expressionValue := expressionValue & $0000FFFF;
|
|
goto 1;
|
|
end; {if}
|
|
if castValue^.token.kind in [longconst,ulongconst] then begin
|
|
expressionValue := castValue^.token.lval;
|
|
isConstant := true;
|
|
expressionType := tree^.castType;
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
if tree^.token.kind = intconst then begin
|
|
expressionValue := tree^.token.ival;
|
|
expressionType := intPtr;
|
|
isConstant := true;
|
|
end {else if}
|
|
else if tree^.token.kind = uintconst then begin
|
|
expressionValue := tree^.token.ival;
|
|
expressionValue := expressionValue & $0000FFFF;
|
|
expressionType := uIntPtr;
|
|
isConstant := true;
|
|
end {else if}
|
|
else if tree^.token.kind = longconst then begin
|
|
expressionValue := tree^.token.lval;
|
|
expressionType := longPtr;
|
|
isConstant := true;
|
|
end {else if}
|
|
else if tree^.token.kind = ulongconst then begin
|
|
expressionValue := tree^.token.lval;
|
|
expressionType := ulongPtr;
|
|
isConstant := true;
|
|
end {else if}
|
|
else if tree^.token.kind = longlongconst then begin
|
|
llExpressionValue := tree^.token.qval;
|
|
expressionIsLongLong := true;
|
|
if ((llExpressionValue.hi = 0) and (llExpressionValue.lo >= 0))
|
|
or ((llExpressionValue.hi = -1) and (llExpressionValue.lo < 0)) then
|
|
expressionValue := llExpressionValue.lo
|
|
else if llExpressionValue.hi < 0 then
|
|
expressionValue := $80000000
|
|
else
|
|
expressionValue := $7fffffff;
|
|
expressionType := longLongPtr;
|
|
isConstant := true;
|
|
end {else if}
|
|
else if tree^.token.kind = ulonglongconst then begin
|
|
llExpressionValue := tree^.token.qval;
|
|
expressionIsLongLong := true;
|
|
if llExpressionValue.hi = 0 then
|
|
expressionValue := llExpressionValue.lo
|
|
else
|
|
expressionValue := $FFFFFFFF;
|
|
expressionType := ulongLongPtr;
|
|
isConstant := true;
|
|
end {else if}
|
|
else if tree^.token.kind = doubleconst then begin
|
|
realExpressionValue := tree^.token.rval;
|
|
expressionType := extendedPtr;
|
|
isConstant := true;
|
|
if kind in [arrayExpression,preprocessorExpression] then begin
|
|
expressionType := intPtr;
|
|
expressionValue := 1;
|
|
Error(47);
|
|
end; {if}
|
|
end {else if}
|
|
else if tree^.token.kind = stringconst then begin
|
|
expressionValue := ord4(tree^.token.sval);
|
|
expressionType := stringTypePtr;
|
|
isConstant := true;
|
|
if kind in [arrayExpression,preprocessorExpression] then begin
|
|
expressionType := intPtr;
|
|
expressionValue := 1;
|
|
Error(47);
|
|
end; {if}
|
|
end {else if}
|
|
else if kind in [arrayExpression,preprocessorExpression] then begin
|
|
DisposeTree(initializerTree);
|
|
expressionValue := 1;
|
|
end; {else if}
|
|
end; {else}
|
|
end; {else}
|
|
1:
|
|
end; {Expression}
|
|
|
|
|
|
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). }
|
|
|
|
begin {GetLLExpressionValue}
|
|
if expressionIsLongLong then
|
|
val := llExpressionValue
|
|
else begin
|
|
val.lo := expressionValue;
|
|
val.hi := 0;
|
|
if expressionValue < 0 then
|
|
if expressionType^.kind = scalarType then
|
|
if expressionType^.baseType in [cgByte,cgWord,cgLong] then
|
|
val.hi := -1;
|
|
end;
|
|
end; {GetLLExpressionValue}
|
|
|
|
|
|
procedure InitExpression;
|
|
|
|
{ initialize the expression handler }
|
|
|
|
begin {InitExpression}
|
|
startTerm := [ident,intconst,uintconst,longconst,ulongconst,longlongconst,
|
|
ulonglongconst,doubleconst,stringconst,_Genericsy];
|
|
startExpression:= startTerm +
|
|
[lparench,asteriskch,andch,plusch,minusch,excch,tildech,sizeofsy,
|
|
plusplusop,minusminusop,typedef,_Alignofsy];
|
|
end; {InitExpression}
|
|
|
|
end.
|
|
|
|
{$append 'expression.asm'}
|