Improvements to binary and unary expression error messages.
This patch improves binary expression error messages and unary expression error messages. The location uses the virtual token created and the description about the error contains more detail. gcc/m2/ChangeLog: * gm2-compiler/M2GCCDeclare.mod: Corrected spacing. * gm2-compiler/M2GenGCC.mod (M2MetaError): Import MetaErrorStringT1. (DynamicStrings): Import ConCatChar. (M2Quads) Import GetM2OperatorDesc and GetQuadOp. (m2except): Import list inserted identifiers GetM2OperatorDesc and GetQuadOp. (CodeMakeAdr): Corrected grammer of the error message. (FoldMakeAdr): Corrected grammer of the error message. (CheckBinaryOperand): New procedure function. (BinaryOperands): Rewritten. (UnaryOperand): New procedure function. (FoldAdd): Corrected spacing. (CodeAddChecked): Corrected spacing. (CodeAddCheck): Corrected spacing. (CodeMult): Corrected spacing. (CodeModM2Checked): Corrected spacing. (CodeModM2Checked): Corrected spacing. (FoldDivM2): Corrected spacing. (CodeSetShift): Corrected spacing. (FoldSetRotate): Corrected spacing. (CodeSetRotate): Corrected spacing. (CodeUnaryCheck): Corrected spacing. (CodeUnaryCheck): Corrected spacing. (CheckReferenced): Improved error message grammar. (CodeIfLess): Improved error message grammar. (CodeIfGre): Improved error message grammar. (CodeIfLessEqu): Improved error message grammar. (CodeIfSetEqu): Improved error message grammar. * gm2-compiler/M2Quads.def (GetQuadOp): New procedure function defined and exported. (GetM2OperatorDesc) New procedure function defined and exported. * gm2-compiler/M2Quads.mod (GetQuadOp): New procedure function. (GetM2OperatorDesc) New procedure function. * gm2-compiler/M2Scope.mod (GetGlobalQuads): Added condition for InitStartOp, which fixes an error scope bug when resolving constant expressions. * gm2-gcc/m2statement.def: Improved comment. Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
This commit is contained in:
parent
82bcda7e2a
commit
06642d296d
|
@ -2823,18 +2823,18 @@ BEGIN
|
||||||
|
|
||||||
IF Debugging
|
IF Debugging
|
||||||
THEN
|
THEN
|
||||||
n := GetSymName(scope) ;
|
n := GetSymName (scope) ;
|
||||||
printf1('declaring symbols in BLOCK %a\n', n)
|
printf1 ('declaring symbols in BLOCK %a\n', n)
|
||||||
END ;
|
END ;
|
||||||
IF IsProcedure(scope)
|
IF IsProcedure (scope)
|
||||||
THEN
|
THEN
|
||||||
StartDeclareProcedureScope(scope)
|
StartDeclareProcedureScope (scope)
|
||||||
ELSE
|
ELSE
|
||||||
StartDeclareModuleScope(scope)
|
StartDeclareModuleScope (scope)
|
||||||
END ;
|
END ;
|
||||||
IF Debugging
|
IF Debugging
|
||||||
THEN
|
THEN
|
||||||
n := GetSymName(scope) ;
|
n := GetSymName (scope) ;
|
||||||
printf1('\nEND declaring symbols in BLOCK %a\n', n)
|
printf1('\nEND declaring symbols in BLOCK %a\n', n)
|
||||||
END
|
END
|
||||||
END StartDeclareScope ;
|
END StartDeclareScope ;
|
||||||
|
|
|
@ -84,7 +84,9 @@ FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToLocation, Make
|
||||||
FROM M2Code IMPORT CodeBlock ;
|
FROM M2Code IMPORT CodeBlock ;
|
||||||
FROM M2Debug IMPORT Assert ;
|
FROM M2Debug IMPORT Assert ;
|
||||||
FROM M2Error IMPORT InternalError, WriteFormat0, WriteFormat1, WriteFormat2, WarnStringAt ;
|
FROM M2Error IMPORT InternalError, WriteFormat0, WriteFormat1, WriteFormat2, WarnStringAt ;
|
||||||
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3, MetaError1, MetaError2 ;
|
|
||||||
|
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
|
||||||
|
MetaError1, MetaError2, MetaErrorStringT1 ;
|
||||||
|
|
||||||
FROM M2Options IMPORT DisplayQuadruples, UnboundedByReference, PedanticCast,
|
FROM M2Options IMPORT DisplayQuadruples, UnboundedByReference, PedanticCast,
|
||||||
VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
|
VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
|
||||||
|
@ -105,7 +107,10 @@ FROM M2Base IMPORT MixTypes, NegateType, ActivationPointer, IsMathType,
|
||||||
|
|
||||||
FROM M2Bitset IMPORT Bitset ;
|
FROM M2Bitset IMPORT Bitset ;
|
||||||
FROM NameKey IMPORT Name, MakeKey, KeyToCharStar, LengthKey, makekey, NulName ;
|
FROM NameKey IMPORT Name, MakeKey, KeyToCharStar, LengthKey, makekey, NulName ;
|
||||||
FROM DynamicStrings IMPORT string, InitString, KillString, String, InitStringCharStar, Mark, Slice, ConCat ;
|
|
||||||
|
FROM DynamicStrings IMPORT string, InitString, KillString, String,
|
||||||
|
InitStringCharStar, Mark, Slice, ConCat, ConCatChar ;
|
||||||
|
|
||||||
FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
|
FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
|
||||||
FROM M2System IMPORT Address, Word, System, TBitSize, MakeAdr, IsSystemType, IsGenericSystemType, IsRealN, IsComplexN, IsSetN, IsWordN, Loc, Byte ;
|
FROM M2System IMPORT Address, Word, System, TBitSize, MakeAdr, IsSystemType, IsGenericSystemType, IsRealN, IsComplexN, IsSetN, IsWordN, Loc, Byte ;
|
||||||
FROM M2FileName IMPORT CalculateFileName ;
|
FROM M2FileName IMPORT CalculateFileName ;
|
||||||
|
@ -242,6 +247,7 @@ FROM m2except IMPORT BuildThrow, BuildTryBegin, BuildTryEnd,
|
||||||
FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced, GetNextQuad,
|
FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced, GetNextQuad,
|
||||||
SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok,
|
SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok,
|
||||||
QuadToTokenNo, DisplayQuad, GetQuadtok,
|
QuadToTokenNo, DisplayQuad, GetQuadtok,
|
||||||
|
GetM2OperatorDesc, GetQuadOp,
|
||||||
DisplayQuadList ;
|
DisplayQuadList ;
|
||||||
|
|
||||||
FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible ;
|
FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible ;
|
||||||
|
@ -553,7 +559,10 @@ VAR
|
||||||
op : QuadOperator ;
|
op : QuadOperator ;
|
||||||
op1,
|
op1,
|
||||||
op2,
|
op2,
|
||||||
op3 : CARDINAL ;
|
op3,
|
||||||
|
op1pos,
|
||||||
|
op2pos,
|
||||||
|
op3pos : CARDINAL ;
|
||||||
Changed: BOOLEAN ;
|
Changed: BOOLEAN ;
|
||||||
BEGIN
|
BEGIN
|
||||||
Changed := FALSE ;
|
Changed := FALSE ;
|
||||||
|
@ -566,7 +575,8 @@ BEGIN
|
||||||
THEN
|
THEN
|
||||||
tokenno := QuadToTokenNo (quad)
|
tokenno := QuadToTokenNo (quad)
|
||||||
END ;
|
END ;
|
||||||
GetQuad (quad, op, op1, op2, op3) ;
|
GetQuadtok (quad, op, op1, op2, op3,
|
||||||
|
op1pos, op2pos, op3pos) ;
|
||||||
CASE op OF
|
CASE op OF
|
||||||
|
|
||||||
StandardFunctionOp : FoldStandardFunction (tokenno, p, quad, op1, op2, op3) |
|
StandardFunctionOp : FoldStandardFunction (tokenno, p, quad, op1, op2, op3) |
|
||||||
|
@ -576,18 +586,18 @@ BEGIN
|
||||||
LogicalAndOp : FoldSetAnd (tokenno, p, quad, op1, op2, op3) |
|
LogicalAndOp : FoldSetAnd (tokenno, p, quad, op1, op2, op3) |
|
||||||
LogicalXorOp : FoldSymmetricDifference (tokenno, p, quad, op1, op2, op3) |
|
LogicalXorOp : FoldSymmetricDifference (tokenno, p, quad, op1, op2, op3) |
|
||||||
BecomesOp : FoldBecomes (tokenno, p, quad, op1, op3) |
|
BecomesOp : FoldBecomes (tokenno, p, quad, op1, op3) |
|
||||||
AddOp : FoldAdd (tokenno, p, quad, op1, op2, op3) |
|
AddOp : FoldAdd (op1pos, p, quad, op1, op2, op3) |
|
||||||
SubOp : FoldSub (tokenno, p, quad, op1, op2, op3) |
|
SubOp : FoldSub (op1pos, p, quad, op1, op2, op3) |
|
||||||
MultOp : FoldMult (tokenno, p, quad, op1, op2, op3) |
|
MultOp : FoldMult (op1pos, p, quad, op1, op2, op3) |
|
||||||
DivM2Op : FoldDivM2 (tokenno, p, quad, op1, op2, op3) |
|
DivM2Op : FoldDivM2 (op1pos, p, quad, op1, op2, op3) |
|
||||||
ModM2Op : FoldModM2 (tokenno, p, quad, op1, op2, op3) |
|
ModM2Op : FoldModM2 (op1pos, p, quad, op1, op2, op3) |
|
||||||
DivTruncOp : FoldDivTrunc (tokenno, p, quad, op1, op2, op3) |
|
DivTruncOp : FoldDivTrunc (op1pos, p, quad, op1, op2, op3) |
|
||||||
ModTruncOp : FoldModTrunc (tokenno, p, quad, op1, op2, op3) |
|
ModTruncOp : FoldModTrunc (op1pos, p, quad, op1, op2, op3) |
|
||||||
DivCeilOp : FoldDivCeil (tokenno, p, quad, op1, op2, op3) |
|
DivCeilOp : FoldDivCeil (op1pos, p, quad, op1, op2, op3) |
|
||||||
ModCeilOp : FoldModCeil (tokenno, p, quad, op1, op2, op3) |
|
ModCeilOp : FoldModCeil (op1pos, p, quad, op1, op2, op3) |
|
||||||
DivFloorOp : FoldDivFloor (tokenno, p, quad, op1, op2, op3) |
|
DivFloorOp : FoldDivFloor (op1pos, p, quad, op1, op2, op3) |
|
||||||
ModFloorOp : FoldModFloor (tokenno, p, quad, op1, op2, op3) |
|
ModFloorOp : FoldModFloor (op1pos, p, quad, op1, op2, op3) |
|
||||||
NegateOp : FoldNegate (tokenno, p, quad, op1, op3) |
|
NegateOp : FoldNegate (op1pos, p, quad, op1, op3) |
|
||||||
SizeOp : FoldSize (tokenno, p, quad, op1, op2, op3) |
|
SizeOp : FoldSize (tokenno, p, quad, op1, op2, op3) |
|
||||||
RecordFieldOp : FoldRecordField (tokenno, p, quad, op1, op2, op3) |
|
RecordFieldOp : FoldRecordField (tokenno, p, quad, op1, op2, op3) |
|
||||||
HighOp : FoldHigh (tokenno, p, quad, op1, op2, op3) |
|
HighOp : FoldHigh (tokenno, p, quad, op1, op2, op3) |
|
||||||
|
@ -2244,7 +2254,7 @@ BEGIN
|
||||||
IF CompareTrees(bits, max)>0
|
IF CompareTrees(bits, max)>0
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT0 (CurrentQuadToken,
|
MetaErrorT0 (CurrentQuadToken,
|
||||||
'total number of bit specified as parameters to {%kMAKEADR} exceeds address width')
|
'total number of bits specified as parameters to {%kMAKEADR} exceeds address width')
|
||||||
END ;
|
END ;
|
||||||
SubQuad(n) ;
|
SubQuad(n) ;
|
||||||
BuildAssignmentStatement (location, res, val)
|
BuildAssignmentStatement (location, res, val)
|
||||||
|
@ -2314,7 +2324,7 @@ BEGIN
|
||||||
IF GetType(op3)=NulSym
|
IF GetType(op3)=NulSym
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT0 (tokenno,
|
MetaErrorT0 (tokenno,
|
||||||
'must supply typed constants to {%kMAKEADR}')
|
'constants passed to {%kMAKEADR} must be typed')
|
||||||
ELSE
|
ELSE
|
||||||
type := GetType(op3) ;
|
type := GetType(op3) ;
|
||||||
tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ;
|
tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ;
|
||||||
|
@ -2333,7 +2343,7 @@ BEGIN
|
||||||
IF CompareTrees(bits, max)>0
|
IF CompareTrees(bits, max)>0
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT0 (tokenno,
|
MetaErrorT0 (tokenno,
|
||||||
'total number of bit specified as parameters to {%kMAKEADR} exceeds address width')
|
'total number of bits specified as parameters to {%kMAKEADR} exceeds address width')
|
||||||
END ;
|
END ;
|
||||||
PutConst(r, Address) ;
|
PutConst(r, Address) ;
|
||||||
AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(Address), val)) ;
|
AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(Address), val)) ;
|
||||||
|
@ -3480,6 +3490,91 @@ BEGIN
|
||||||
END CodeBinarySet ;
|
END CodeBinarySet ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
CheckUnaryOperand - checks to see whether operand is using a generic type.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE CheckUnaryOperand (quad: CARDINAL; operand: CARDINAL) : BOOLEAN ;
|
||||||
|
VAR
|
||||||
|
type : CARDINAL ;
|
||||||
|
s, op : String ;
|
||||||
|
BEGIN
|
||||||
|
type := SkipType (GetType (operand)) ;
|
||||||
|
IF (Word=type) OR IsWordN (type) OR (Byte=type) OR (Loc=type)
|
||||||
|
THEN
|
||||||
|
op := GetM2OperatorDesc (GetQuadOp (quad)) ;
|
||||||
|
s := InitString ('operand of type {%1Ets} is not allowed in an unary expression') ;
|
||||||
|
IF op # NIL
|
||||||
|
THEN
|
||||||
|
s := ConCatChar (s, ' ') ;
|
||||||
|
s := ConCat (s, Mark (op))
|
||||||
|
END ;
|
||||||
|
MetaErrorStringT1 (CurrentQuadToken, s, operand) ;
|
||||||
|
RETURN FALSE
|
||||||
|
END ;
|
||||||
|
RETURN TRUE
|
||||||
|
END CheckUnaryOperand ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
UnaryOperand - returns TRUE if operand is acceptable for
|
||||||
|
unary operator: + -. If FALSE
|
||||||
|
is returned, an error message will be generated
|
||||||
|
and the quad is deleted.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE UnaryOperand (quad: CARDINAL; operand: CARDINAL) : BOOLEAN ;
|
||||||
|
BEGIN
|
||||||
|
IF NOT CheckUnaryOperand (quad, operand)
|
||||||
|
THEN
|
||||||
|
SubQuad (quad) ; (* We do not want multiple copies of the same error. *)
|
||||||
|
RETURN FALSE
|
||||||
|
END ;
|
||||||
|
RETURN TRUE
|
||||||
|
END UnaryOperand ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
CheckBinaryOperand - checks to see whether operand is using a generic type.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE CheckBinaryOperand (quad: CARDINAL; isleft: BOOLEAN;
|
||||||
|
operand: CARDINAL; result: BOOLEAN) : BOOLEAN ;
|
||||||
|
VAR
|
||||||
|
type : CARDINAL ;
|
||||||
|
qop : QuadOperator ;
|
||||||
|
op1,
|
||||||
|
op2,
|
||||||
|
op3,
|
||||||
|
op1pos,
|
||||||
|
op2pos,
|
||||||
|
op3pos: CARDINAL ;
|
||||||
|
s, op : String ;
|
||||||
|
BEGIN
|
||||||
|
type := SkipType (GetType (operand)) ;
|
||||||
|
IF (Word=type) OR IsWordN (type) OR (Byte=type) OR (Loc=type)
|
||||||
|
THEN
|
||||||
|
GetQuadtok (quad, qop, op1, op2, op3,
|
||||||
|
op1pos, op2pos, op3pos) ;
|
||||||
|
op := GetM2OperatorDesc (GetQuadOp (quad)) ;
|
||||||
|
IF isleft
|
||||||
|
THEN
|
||||||
|
s := InitString ('left operand {%1Ea} of type {%1Ets} is not allowed in binary expression')
|
||||||
|
ELSE
|
||||||
|
s := InitString ('right operand {%1Ea} of type {%1Ets} is not allowed in binary expression')
|
||||||
|
END ;
|
||||||
|
IF op # NIL
|
||||||
|
THEN
|
||||||
|
s := ConCatChar (s, ' ') ;
|
||||||
|
s := ConCat (s, Mark (op))
|
||||||
|
END ;
|
||||||
|
MetaErrorStringT1 (op1pos, s, operand) ;
|
||||||
|
RETURN FALSE
|
||||||
|
END ;
|
||||||
|
RETURN result
|
||||||
|
END CheckBinaryOperand ;
|
||||||
|
|
||||||
|
|
||||||
(*
|
(*
|
||||||
BinaryOperands - returns TRUE if, l, and, r, are acceptable for
|
BinaryOperands - returns TRUE if, l, and, r, are acceptable for
|
||||||
binary operator: + - / * and friends. If FALSE
|
binary operator: + - / * and friends. If FALSE
|
||||||
|
@ -3489,25 +3584,13 @@ END CodeBinarySet ;
|
||||||
|
|
||||||
PROCEDURE BinaryOperands (quad: CARDINAL; l, r: CARDINAL) : BOOLEAN ;
|
PROCEDURE BinaryOperands (quad: CARDINAL; l, r: CARDINAL) : BOOLEAN ;
|
||||||
VAR
|
VAR
|
||||||
tl, tr: CARDINAL ;
|
|
||||||
result: BOOLEAN ;
|
result: BOOLEAN ;
|
||||||
BEGIN
|
BEGIN
|
||||||
result := TRUE ;
|
result := CheckBinaryOperand (quad, TRUE, l, TRUE) ;
|
||||||
tl := SkipType(GetType(l)) ;
|
result := CheckBinaryOperand (quad, FALSE, r, result) ;
|
||||||
tr := SkipType(GetType(r)) ;
|
|
||||||
IF (Word=tl) OR IsWordN(tl) OR (Byte=tl) OR (Loc=tl)
|
|
||||||
THEN
|
|
||||||
MetaErrorT1 (CurrentQuadToken, 'operand of type {%1Ets} is not allowed in a binary expression', l) ;
|
|
||||||
result := FALSE
|
|
||||||
END ;
|
|
||||||
IF (Word=tr) OR IsWordN(tr) OR (Byte=tl) OR (Loc=tl)
|
|
||||||
THEN
|
|
||||||
MetaErrorT1 (CurrentQuadToken, 'operand of type {%1Ets} is not allowed in a binary expression', r) ;
|
|
||||||
result := FALSE
|
|
||||||
END ;
|
|
||||||
IF NOT result
|
IF NOT result
|
||||||
THEN
|
THEN
|
||||||
SubQuad (quad) (* we do not want multiple copies of the same error *)
|
SubQuad (quad) (* We do not want multiple copies of the same error. *)
|
||||||
END ;
|
END ;
|
||||||
RETURN result
|
RETURN result
|
||||||
END BinaryOperands ;
|
END BinaryOperands ;
|
||||||
|
@ -3535,9 +3618,9 @@ BEGIN
|
||||||
SubQuad(quad) ;
|
SubQuad(quad) ;
|
||||||
s := KillString(s)
|
s := KillString(s)
|
||||||
ELSE
|
ELSE
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
FoldBinary(tokenno, p, BuildAdd, quad, op1, op2, op3)
|
FoldBinary (tokenno, p, BuildAdd, quad, op1, op2, op3)
|
||||||
END
|
END
|
||||||
END
|
END
|
||||||
END FoldAdd ;
|
END FoldAdd ;
|
||||||
|
@ -3592,7 +3675,7 @@ END CodeAdd ;
|
||||||
PROCEDURE FoldSub (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldSub (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
FoldBinary(tokenno, p, BuildSub, quad, op1, op2, op3)
|
FoldBinary(tokenno, p, BuildSub, quad, op1, op2, op3)
|
||||||
END
|
END
|
||||||
|
@ -3621,7 +3704,7 @@ END CodeSubChecked ;
|
||||||
|
|
||||||
PROCEDURE CodeSubCheck (quad: CARDINAL; left, right: CARDINAL) ;
|
PROCEDURE CodeSubCheck (quad: CARDINAL; left, right: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, left, right)
|
IF BinaryOperands (quad, left, right)
|
||||||
THEN
|
THEN
|
||||||
CodeBinaryCheck (BuildSubCheck, quad)
|
CodeBinaryCheck (BuildSubCheck, quad)
|
||||||
END
|
END
|
||||||
|
@ -3634,7 +3717,7 @@ END CodeSubCheck ;
|
||||||
|
|
||||||
PROCEDURE CodeSub (quad: CARDINAL; left, right: CARDINAL) ;
|
PROCEDURE CodeSub (quad: CARDINAL; left, right: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, left, right)
|
IF BinaryOperands (quad, left, right)
|
||||||
THEN
|
THEN
|
||||||
CodeBinary (BuildSub, quad)
|
CodeBinary (BuildSub, quad)
|
||||||
END
|
END
|
||||||
|
@ -3648,7 +3731,7 @@ END CodeSub ;
|
||||||
PROCEDURE FoldMult (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldMult (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
FoldBinary(tokenno, p, BuildMult, quad, op1, op2, op3)
|
FoldBinary(tokenno, p, BuildMult, quad, op1, op2, op3)
|
||||||
END
|
END
|
||||||
|
@ -3776,7 +3859,7 @@ END BinaryOperandRealFamily ;
|
||||||
PROCEDURE FoldDivM2 (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldDivM2 (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||||
THEN
|
THEN
|
||||||
|
@ -3813,7 +3896,7 @@ END CodeDivM2 ;
|
||||||
PROCEDURE FoldModM2 (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldModM2 (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
FoldBinary(tokenno, p, BuildModM2, quad, op1, op2, op3)
|
FoldBinary(tokenno, p, BuildModM2, quad, op1, op2, op3)
|
||||||
END
|
END
|
||||||
|
@ -3826,7 +3909,7 @@ END FoldModM2 ;
|
||||||
|
|
||||||
PROCEDURE CodeModM2 (quad: CARDINAL; left, right: CARDINAL) ;
|
PROCEDURE CodeModM2 (quad: CARDINAL; left, right: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, left, right)
|
IF BinaryOperands (quad, left, right)
|
||||||
THEN
|
THEN
|
||||||
CodeBinary (BuildModM2, quad)
|
CodeBinary (BuildModM2, quad)
|
||||||
END
|
END
|
||||||
|
@ -3840,7 +3923,7 @@ END CodeModM2 ;
|
||||||
PROCEDURE FoldDivTrunc (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldDivTrunc (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||||
THEN
|
THEN
|
||||||
|
@ -3858,7 +3941,7 @@ END FoldDivTrunc ;
|
||||||
|
|
||||||
PROCEDURE CodeDivTrunc (quad: CARDINAL; left, right: CARDINAL) ;
|
PROCEDURE CodeDivTrunc (quad: CARDINAL; left, right: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, left, right)
|
IF BinaryOperands (quad, left, right)
|
||||||
THEN
|
THEN
|
||||||
IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
|
IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
|
||||||
THEN
|
THEN
|
||||||
|
@ -3904,7 +3987,7 @@ END CodeModTrunc ;
|
||||||
PROCEDURE FoldDivCeil (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldDivCeil (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||||
THEN
|
THEN
|
||||||
|
@ -3922,7 +4005,7 @@ END FoldDivCeil ;
|
||||||
|
|
||||||
PROCEDURE CodeDivCeil (quad: CARDINAL; left, right: CARDINAL) ;
|
PROCEDURE CodeDivCeil (quad: CARDINAL; left, right: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, left, right)
|
IF BinaryOperands (quad, left, right)
|
||||||
THEN
|
THEN
|
||||||
IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
|
IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
|
||||||
THEN
|
THEN
|
||||||
|
@ -3941,7 +4024,7 @@ END CodeDivCeil ;
|
||||||
PROCEDURE FoldModCeil (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldModCeil (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
FoldBinary(tokenno, p, BuildModCeil, quad, op1, op2, op3)
|
FoldBinary(tokenno, p, BuildModCeil, quad, op1, op2, op3)
|
||||||
END
|
END
|
||||||
|
@ -3968,7 +4051,7 @@ END CodeModCeil ;
|
||||||
PROCEDURE FoldDivFloor (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldDivFloor (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||||
THEN
|
THEN
|
||||||
|
@ -4005,7 +4088,7 @@ END CodeDivFloor ;
|
||||||
PROCEDURE FoldModFloor (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldModFloor (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, op2, op3)
|
IF BinaryOperands (quad, op2, op3)
|
||||||
THEN
|
THEN
|
||||||
FoldBinary(tokenno, p, BuildModFloor, quad, op1, op2, op3)
|
FoldBinary(tokenno, p, BuildModFloor, quad, op1, op2, op3)
|
||||||
END
|
END
|
||||||
|
@ -4018,7 +4101,7 @@ END FoldModFloor ;
|
||||||
|
|
||||||
PROCEDURE CodeModFloor (quad: CARDINAL; left, right: CARDINAL) ;
|
PROCEDURE CodeModFloor (quad: CARDINAL; left, right: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF BinaryOperands(quad, left, right)
|
IF BinaryOperands (quad, left, right)
|
||||||
THEN
|
THEN
|
||||||
CodeBinary (BuildModFloor, quad)
|
CodeBinary (BuildModFloor, quad)
|
||||||
END
|
END
|
||||||
|
@ -4437,7 +4520,7 @@ END FoldBinarySet ;
|
||||||
PROCEDURE FoldSetOr (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldSetOr (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
FoldBinarySet(tokenno, p, SetOr, quad, op1, op2, op3)
|
FoldBinarySet (tokenno, p, SetOr, quad, op1, op2, op3)
|
||||||
END FoldSetOr ;
|
END FoldSetOr ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4447,7 +4530,7 @@ END FoldSetOr ;
|
||||||
|
|
||||||
PROCEDURE CodeSetOr (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
PROCEDURE CodeSetOr (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
CodeBinarySet(BuildLogicalOr, SetOr, quad, op1, op2, op3)
|
CodeBinarySet (BuildLogicalOr, SetOr, quad, op1, op2, op3)
|
||||||
END CodeSetOr ;
|
END CodeSetOr ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4468,7 +4551,7 @@ END FoldSetAnd ;
|
||||||
|
|
||||||
PROCEDURE CodeSetAnd (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
PROCEDURE CodeSetAnd (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
CodeBinarySet(BuildLogicalAnd, SetAnd, quad, op1, op2, op3)
|
CodeBinarySet (BuildLogicalAnd, SetAnd, quad, op1, op2, op3)
|
||||||
END CodeSetAnd ;
|
END CodeSetAnd ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4566,12 +4649,12 @@ END FoldSetShift ;
|
||||||
|
|
||||||
PROCEDURE CodeSetShift (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
PROCEDURE CodeSetShift (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
CodeBinarySetShift(BuildLogicalShift,
|
CodeBinarySetShift (BuildLogicalShift,
|
||||||
SetShift,
|
SetShift,
|
||||||
MakeKey('ShiftVal'),
|
MakeKey('ShiftVal'),
|
||||||
MakeKey('ShiftLeft'),
|
MakeKey('ShiftLeft'),
|
||||||
MakeKey('ShiftRight'),
|
MakeKey('ShiftRight'),
|
||||||
quad, op1, op2, op3)
|
quad, op1, op2, op3)
|
||||||
END CodeSetShift ;
|
END CodeSetShift ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4592,12 +4675,12 @@ END FoldSetRotate ;
|
||||||
|
|
||||||
PROCEDURE CodeSetRotate (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
PROCEDURE CodeSetRotate (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
CodeBinarySetShift(BuildLogicalRotate,
|
CodeBinarySetShift (BuildLogicalRotate,
|
||||||
SetRotate,
|
SetRotate,
|
||||||
MakeKey('RotateVal'),
|
MakeKey ('RotateVal'),
|
||||||
MakeKey('RotateLeft'),
|
MakeKey ('RotateLeft'),
|
||||||
MakeKey('RotateRight'),
|
MakeKey ('RotateRight'),
|
||||||
quad, op1, op2, op3)
|
quad, op1, op2, op3)
|
||||||
END CodeSetRotate ;
|
END CodeSetRotate ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4620,8 +4703,8 @@ END FoldSetLogicalDifference ;
|
||||||
|
|
||||||
PROCEDURE CodeSetLogicalDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
PROCEDURE CodeSetLogicalDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
CodeBinarySet(BuildLogicalDifference, SetDifference,
|
CodeBinarySet (BuildLogicalDifference, SetDifference,
|
||||||
quad, op1, op2, op3)
|
quad, op1, op2, op3)
|
||||||
END CodeSetLogicalDifference ;
|
END CodeSetLogicalDifference ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4632,7 +4715,7 @@ END CodeSetLogicalDifference ;
|
||||||
PROCEDURE FoldSymmetricDifference (tokenno: CARDINAL; p: WalkAction;
|
PROCEDURE FoldSymmetricDifference (tokenno: CARDINAL; p: WalkAction;
|
||||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
FoldBinarySet(tokenno, p, SetSymmetricDifference, quad, op1, op2, op3)
|
FoldBinarySet (tokenno, p, SetSymmetricDifference, quad, op1, op2, op3)
|
||||||
END FoldSymmetricDifference ;
|
END FoldSymmetricDifference ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4642,8 +4725,8 @@ END FoldSymmetricDifference ;
|
||||||
|
|
||||||
PROCEDURE CodeSetSymmetricDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
PROCEDURE CodeSetSymmetricDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||||
BEGIN
|
BEGIN
|
||||||
CodeBinarySet(BuildSymmetricDifference, SetSymmetricDifference,
|
CodeBinarySet (BuildSymmetricDifference, SetSymmetricDifference,
|
||||||
quad, op1, op2, op3)
|
quad, op1, op2, op3)
|
||||||
END CodeSetSymmetricDifference ;
|
END CodeSetSymmetricDifference ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -4652,7 +4735,7 @@ END CodeSetSymmetricDifference ;
|
||||||
Set operands may be longer than a word.
|
Set operands may be longer than a word.
|
||||||
*)
|
*)
|
||||||
|
|
||||||
PROCEDURE CodeUnarySet (unop: BuildUnarySetFunction; doOp: DoUnaryProcedure;
|
PROCEDURE CodeUnarySet (unop: BuildUnarySetFunction; constop: DoUnaryProcedure;
|
||||||
quad: CARDINAL; result, expr: CARDINAL) ;
|
quad: CARDINAL; result, expr: CARDINAL) ;
|
||||||
VAR
|
VAR
|
||||||
location: location_t ;
|
location: location_t ;
|
||||||
|
@ -4669,7 +4752,7 @@ BEGIN
|
||||||
Assert (FindType (expr) # NulSym) ;
|
Assert (FindType (expr) # NulSym) ;
|
||||||
PutConst (result, FindType (expr)) ;
|
PutConst (result, FindType (expr)) ;
|
||||||
PushValue (expr) ;
|
PushValue (expr) ;
|
||||||
doOp (CurrentQuadToken) ;
|
constop (CurrentQuadToken) ;
|
||||||
PopValue (result) ;
|
PopValue (result) ;
|
||||||
PushValue (result) ;
|
PushValue (result) ;
|
||||||
PutConstSet (result) ;
|
PutConstSet (result) ;
|
||||||
|
@ -4683,10 +4766,10 @@ BEGIN
|
||||||
END
|
END
|
||||||
ELSE
|
ELSE
|
||||||
checkDeclare (result) ;
|
checkDeclare (result) ;
|
||||||
BuildUnaryForeachWordDo(location,
|
BuildUnaryForeachWordDo (location,
|
||||||
Mod2Gcc (GetType (result)), Mod2Gcc (result), Mod2Gcc (expr), unop,
|
Mod2Gcc (GetType (result)), Mod2Gcc (result), Mod2Gcc (expr), unop,
|
||||||
GetMode(result) = LeftValue, GetMode(expr) = LeftValue,
|
GetMode(result) = LeftValue, GetMode(expr) = LeftValue,
|
||||||
IsConst (result), IsConst (expr))
|
IsConst (result), IsConst (expr))
|
||||||
END
|
END
|
||||||
END CodeUnarySet ;
|
END CodeUnarySet ;
|
||||||
|
|
||||||
|
@ -5195,7 +5278,7 @@ PROCEDURE FoldNegate (tokenno: CARDINAL; p: WalkAction;
|
||||||
BEGIN
|
BEGIN
|
||||||
IF IsConstSet (expr)
|
IF IsConstSet (expr)
|
||||||
THEN
|
THEN
|
||||||
FoldUnarySet(tokenno, p, SetNegate, quad, result, expr)
|
FoldUnarySet (tokenno, p, SetNegate, quad, result, expr)
|
||||||
ELSE
|
ELSE
|
||||||
FoldUnary (tokenno, p, BuildNegate, NIL, quad, result, expr)
|
FoldUnary (tokenno, p, BuildNegate, NIL, quad, result, expr)
|
||||||
END
|
END
|
||||||
|
@ -5212,11 +5295,14 @@ BEGIN
|
||||||
IF IsConstSet (op3) OR IsSet (GetType (op3))
|
IF IsConstSet (op3) OR IsSet (GetType (op3))
|
||||||
THEN
|
THEN
|
||||||
CodeUnarySet (BuildSetNegate, SetNegate, quad, op1, op3)
|
CodeUnarySet (BuildSetNegate, SetNegate, quad, op1, op3)
|
||||||
ELSIF MustCheckOverflow (quad)
|
ELSIF UnaryOperand (quad, op3)
|
||||||
THEN
|
THEN
|
||||||
CodeUnaryCheck (BuildNegateCheck, NIL, quad, op1, op3)
|
IF MustCheckOverflow (quad)
|
||||||
ELSE
|
THEN
|
||||||
CodeUnary (BuildNegate, NIL, quad, op1, op3)
|
CodeUnaryCheck (BuildNegateCheck, NIL, quad, op1, op3)
|
||||||
|
ELSE
|
||||||
|
CodeUnary (BuildNegate, NIL, quad, op1, op3)
|
||||||
|
END
|
||||||
END
|
END
|
||||||
END CodeNegateChecked ;
|
END CodeNegateChecked ;
|
||||||
|
|
||||||
|
@ -6288,7 +6374,7 @@ BEGIN
|
||||||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT2 (CurrentQuadToken,
|
MetaErrorT2 (CurrentQuadToken,
|
||||||
'comparison tests between are composite types not allowed {%1Eatd} and {%2atd}',
|
'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
|
||||||
op1, op2)
|
op1, op2)
|
||||||
ELSE
|
ELSE
|
||||||
ConvertBinaryOperands(location,
|
ConvertBinaryOperands(location,
|
||||||
|
@ -6385,7 +6471,7 @@ BEGIN
|
||||||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT2 (CurrentQuadToken,
|
MetaErrorT2 (CurrentQuadToken,
|
||||||
'comparison tests between are composite types not allowed {%1Eatd} and {%2atd}',
|
'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
|
||||||
op1, op2)
|
op1, op2)
|
||||||
ELSE
|
ELSE
|
||||||
ConvertBinaryOperands(location,
|
ConvertBinaryOperands(location,
|
||||||
|
@ -6481,7 +6567,7 @@ BEGIN
|
||||||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT2 (CurrentQuadToken,
|
MetaErrorT2 (CurrentQuadToken,
|
||||||
'comparison tests between are composite types not allowed {%1Eatd} and {%2atd}',
|
'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
|
||||||
op1, op2)
|
op1, op2)
|
||||||
ELSE
|
ELSE
|
||||||
ConvertBinaryOperands(location,
|
ConvertBinaryOperands(location,
|
||||||
|
@ -6577,7 +6663,7 @@ BEGIN
|
||||||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT2 (CurrentQuadToken,
|
MetaErrorT2 (CurrentQuadToken,
|
||||||
'comparison tests between are composite types not allowed {%1Eatd} and {%2atd}',
|
'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
|
||||||
op1, op2)
|
op1, op2)
|
||||||
ELSE
|
ELSE
|
||||||
ConvertBinaryOperands(location,
|
ConvertBinaryOperands(location,
|
||||||
|
@ -6731,7 +6817,7 @@ BEGIN
|
||||||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT2 (CurrentQuadToken,
|
MetaErrorT2 (CurrentQuadToken,
|
||||||
'equality tests between are composite types not allowed {%1Eatd} and {%2atd}',
|
'equality tests between composite types not allowed {%1Eatd} and {%2atd}',
|
||||||
op1, op2)
|
op1, op2)
|
||||||
ELSE
|
ELSE
|
||||||
ConvertBinaryOperands(location,
|
ConvertBinaryOperands(location,
|
||||||
|
@ -6780,7 +6866,7 @@ BEGIN
|
||||||
IF IsComposite(op1) OR IsComposite(op2)
|
IF IsComposite(op1) OR IsComposite(op2)
|
||||||
THEN
|
THEN
|
||||||
MetaErrorT2 (CurrentQuadToken,
|
MetaErrorT2 (CurrentQuadToken,
|
||||||
'inequality tests between are composite types not allowed {%1Eatd} and {%2atd}',
|
'inequality tests between composite types not allowed {%1Eatd} and {%2atd}',
|
||||||
op1, op2)
|
op1, op2)
|
||||||
ELSE
|
ELSE
|
||||||
ConvertBinaryOperands(location,
|
ConvertBinaryOperands(location,
|
||||||
|
|
|
@ -128,6 +128,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
|
||||||
GetQuad, GetFirstQuad, GetNextQuad, PutQuad,
|
GetQuad, GetFirstQuad, GetNextQuad, PutQuad,
|
||||||
SubQuad, EraseQuad, GetRealQuad,
|
SubQuad, EraseQuad, GetRealQuad,
|
||||||
GetQuadtok, GetQuadOtok,
|
GetQuadtok, GetQuadOtok,
|
||||||
|
GetQuadOp, GetM2OperatorDesc,
|
||||||
CountQuads,
|
CountQuads,
|
||||||
GetLastFileQuad,
|
GetLastFileQuad,
|
||||||
GetLastQuadNo,
|
GetLastQuadNo,
|
||||||
|
@ -437,6 +438,24 @@ PROCEDURE GetQuad (QuadNo: CARDINAL;
|
||||||
VAR Oper1, Oper2, Oper3: CARDINAL) ;
|
VAR Oper1, Oper2, Oper3: CARDINAL) ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
GetQuadOp - returns the operator for quad.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE GetQuadOp (quad: CARDINAL) : QuadOperator ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
|
||||||
|
(if possible). It returns NIL if no there is not an obvious match
|
||||||
|
in Modula-2. It is assummed that the string will be used during
|
||||||
|
construction of error messages and therefore keywords are
|
||||||
|
wrapped with a format specifier.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE GetM2OperatorDesc (op: QuadOperator) : String ;
|
||||||
|
|
||||||
|
|
||||||
(*
|
(*
|
||||||
GetQuadtok - returns the Quadruple QuadNo.
|
GetQuadtok - returns the Quadruple QuadNo.
|
||||||
*)
|
*)
|
||||||
|
|
|
@ -13381,6 +13381,55 @@ BEGIN
|
||||||
END WriteMode ;
|
END WriteMode ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
GetQuadOp - returns the operator for quad.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE GetQuadOp (quad: CARDINAL) : QuadOperator ;
|
||||||
|
VAR
|
||||||
|
f: QuadFrame ;
|
||||||
|
BEGIN
|
||||||
|
f := GetQF (quad) ;
|
||||||
|
RETURN f^.Operator
|
||||||
|
END GetQuadOp ;
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
|
||||||
|
(if possible). It returns NIL if no there is not an obvious match
|
||||||
|
in Modula-2. It is assummed that the string will be used during
|
||||||
|
construction of error messages and therefore keywords are
|
||||||
|
wrapped with a format specifier.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE GetM2OperatorDesc (op: QuadOperator) : String ;
|
||||||
|
BEGIN
|
||||||
|
CASE op OF
|
||||||
|
|
||||||
|
NegateOp : RETURN InitString ('-') |
|
||||||
|
AddOp : RETURN InitString ('+') |
|
||||||
|
SubOp : RETURN InitString ('-') |
|
||||||
|
MultOp : RETURN InitString ('*') |
|
||||||
|
DivM2Op,
|
||||||
|
DivCeilOp,
|
||||||
|
DivFloorOp,
|
||||||
|
DivTruncOp : RETURN InitString ('{%kDIV}') |
|
||||||
|
ModM2Op,
|
||||||
|
ModCeilOp,
|
||||||
|
ModFloorOp : RETURN InitString ('{%kMOD}') |
|
||||||
|
ModTruncOp : RETURN InitString ('{%kREM}') |
|
||||||
|
LogicalOrOp : RETURN InitString ('{%kOR}') |
|
||||||
|
LogicalAndOp: RETURN InitString ('{%kAND}') |
|
||||||
|
InclOp : RETURN InitString ('{%kINCL}') |
|
||||||
|
ExclOp : RETURN InitString ('{%kEXCL}')
|
||||||
|
|
||||||
|
ELSE
|
||||||
|
RETURN NIL
|
||||||
|
END
|
||||||
|
END GetM2OperatorDesc ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(*
|
(*
|
||||||
PushExit - pushes the exit value onto the EXIT stack.
|
PushExit - pushes the exit value onto the EXIT stack.
|
||||||
*)
|
*)
|
||||||
|
|
|
@ -186,6 +186,15 @@ BEGIN
|
||||||
nb := AddToRange (nb, TRUE, i) ;
|
nb := AddToRange (nb, TRUE, i) ;
|
||||||
SetScope (nb, op3, definitionscope)
|
SetScope (nb, op3, definitionscope)
|
||||||
ELSIF op=StartModFileOp
|
ELSIF op=StartModFileOp
|
||||||
|
THEN
|
||||||
|
nb := AddToRange (nb, TRUE, i) ;
|
||||||
|
IF IsDefImp (op3)
|
||||||
|
THEN
|
||||||
|
SetScope (nb, op3, implementationscope)
|
||||||
|
ELSE
|
||||||
|
SetScope (nb, op3, programscope)
|
||||||
|
END
|
||||||
|
ELSIF op=InitStartOp
|
||||||
THEN
|
THEN
|
||||||
nb := AddToRange (nb, TRUE, i) ;
|
nb := AddToRange (nb, TRUE, i) ;
|
||||||
IF IsDefImp (op3)
|
IF IsDefImp (op3)
|
||||||
|
|
|
@ -227,7 +227,7 @@ PROCEDURE BuildAsm (location: location_t; instr: Tree;
|
||||||
BuildUnaryForeachWordDo - provides the large set operators.
|
BuildUnaryForeachWordDo - provides the large set operators.
|
||||||
Each word (or less) of the set can be
|
Each word (or less) of the set can be
|
||||||
calculated by unop.
|
calculated by unop.
|
||||||
This procedure runs along each word
|
This procedure iterates over each word
|
||||||
of the large set invoking the unop.
|
of the large set invoking the unop.
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue