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
|
||||
THEN
|
||||
n := GetSymName(scope) ;
|
||||
printf1('declaring symbols in BLOCK %a\n', n)
|
||||
n := GetSymName (scope) ;
|
||||
printf1 ('declaring symbols in BLOCK %a\n', n)
|
||||
END ;
|
||||
IF IsProcedure(scope)
|
||||
IF IsProcedure (scope)
|
||||
THEN
|
||||
StartDeclareProcedureScope(scope)
|
||||
StartDeclareProcedureScope (scope)
|
||||
ELSE
|
||||
StartDeclareModuleScope(scope)
|
||||
StartDeclareModuleScope (scope)
|
||||
END ;
|
||||
IF Debugging
|
||||
THEN
|
||||
n := GetSymName(scope) ;
|
||||
n := GetSymName (scope) ;
|
||||
printf1('\nEND declaring symbols in BLOCK %a\n', n)
|
||||
END
|
||||
END StartDeclareScope ;
|
||||
|
|
|
@ -84,7 +84,9 @@ FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToLocation, Make
|
|||
FROM M2Code IMPORT CodeBlock ;
|
||||
FROM M2Debug IMPORT Assert ;
|
||||
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,
|
||||
VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
|
||||
|
@ -105,7 +107,10 @@ FROM M2Base IMPORT MixTypes, NegateType, ActivationPointer, IsMathType,
|
|||
|
||||
FROM M2Bitset IMPORT Bitset ;
|
||||
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 M2System IMPORT Address, Word, System, TBitSize, MakeAdr, IsSystemType, IsGenericSystemType, IsRealN, IsComplexN, IsSetN, IsWordN, Loc, Byte ;
|
||||
FROM M2FileName IMPORT CalculateFileName ;
|
||||
|
@ -242,6 +247,7 @@ FROM m2except IMPORT BuildThrow, BuildTryBegin, BuildTryEnd,
|
|||
FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced, GetNextQuad,
|
||||
SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok,
|
||||
QuadToTokenNo, DisplayQuad, GetQuadtok,
|
||||
GetM2OperatorDesc, GetQuadOp,
|
||||
DisplayQuadList ;
|
||||
|
||||
FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible ;
|
||||
|
@ -553,7 +559,10 @@ VAR
|
|||
op : QuadOperator ;
|
||||
op1,
|
||||
op2,
|
||||
op3 : CARDINAL ;
|
||||
op3,
|
||||
op1pos,
|
||||
op2pos,
|
||||
op3pos : CARDINAL ;
|
||||
Changed: BOOLEAN ;
|
||||
BEGIN
|
||||
Changed := FALSE ;
|
||||
|
@ -566,7 +575,8 @@ BEGIN
|
|||
THEN
|
||||
tokenno := QuadToTokenNo (quad)
|
||||
END ;
|
||||
GetQuad (quad, op, op1, op2, op3) ;
|
||||
GetQuadtok (quad, op, op1, op2, op3,
|
||||
op1pos, op2pos, op3pos) ;
|
||||
CASE op OF
|
||||
|
||||
StandardFunctionOp : FoldStandardFunction (tokenno, p, quad, op1, op2, op3) |
|
||||
|
@ -576,18 +586,18 @@ BEGIN
|
|||
LogicalAndOp : FoldSetAnd (tokenno, p, quad, op1, op2, op3) |
|
||||
LogicalXorOp : FoldSymmetricDifference (tokenno, p, quad, op1, op2, op3) |
|
||||
BecomesOp : FoldBecomes (tokenno, p, quad, op1, op3) |
|
||||
AddOp : FoldAdd (tokenno, p, quad, op1, op2, op3) |
|
||||
SubOp : FoldSub (tokenno, p, quad, op1, op2, op3) |
|
||||
MultOp : FoldMult (tokenno, p, quad, op1, op2, op3) |
|
||||
DivM2Op : FoldDivM2 (tokenno, p, quad, op1, op2, op3) |
|
||||
ModM2Op : FoldModM2 (tokenno, p, quad, op1, op2, op3) |
|
||||
DivTruncOp : FoldDivTrunc (tokenno, p, quad, op1, op2, op3) |
|
||||
ModTruncOp : FoldModTrunc (tokenno, p, quad, op1, op2, op3) |
|
||||
DivCeilOp : FoldDivCeil (tokenno, p, quad, op1, op2, op3) |
|
||||
ModCeilOp : FoldModCeil (tokenno, p, quad, op1, op2, op3) |
|
||||
DivFloorOp : FoldDivFloor (tokenno, p, quad, op1, op2, op3) |
|
||||
ModFloorOp : FoldModFloor (tokenno, p, quad, op1, op2, op3) |
|
||||
NegateOp : FoldNegate (tokenno, p, quad, op1, op3) |
|
||||
AddOp : FoldAdd (op1pos, p, quad, op1, op2, op3) |
|
||||
SubOp : FoldSub (op1pos, p, quad, op1, op2, op3) |
|
||||
MultOp : FoldMult (op1pos, p, quad, op1, op2, op3) |
|
||||
DivM2Op : FoldDivM2 (op1pos, p, quad, op1, op2, op3) |
|
||||
ModM2Op : FoldModM2 (op1pos, p, quad, op1, op2, op3) |
|
||||
DivTruncOp : FoldDivTrunc (op1pos, p, quad, op1, op2, op3) |
|
||||
ModTruncOp : FoldModTrunc (op1pos, p, quad, op1, op2, op3) |
|
||||
DivCeilOp : FoldDivCeil (op1pos, p, quad, op1, op2, op3) |
|
||||
ModCeilOp : FoldModCeil (op1pos, p, quad, op1, op2, op3) |
|
||||
DivFloorOp : FoldDivFloor (op1pos, p, quad, op1, op2, op3) |
|
||||
ModFloorOp : FoldModFloor (op1pos, p, quad, op1, op2, op3) |
|
||||
NegateOp : FoldNegate (op1pos, p, quad, op1, op3) |
|
||||
SizeOp : FoldSize (tokenno, p, quad, op1, op2, op3) |
|
||||
RecordFieldOp : FoldRecordField (tokenno, p, quad, op1, op2, op3) |
|
||||
HighOp : FoldHigh (tokenno, p, quad, op1, op2, op3) |
|
||||
|
@ -2244,7 +2254,7 @@ BEGIN
|
|||
IF CompareTrees(bits, max)>0
|
||||
THEN
|
||||
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 ;
|
||||
SubQuad(n) ;
|
||||
BuildAssignmentStatement (location, res, val)
|
||||
|
@ -2314,7 +2324,7 @@ BEGIN
|
|||
IF GetType(op3)=NulSym
|
||||
THEN
|
||||
MetaErrorT0 (tokenno,
|
||||
'must supply typed constants to {%kMAKEADR}')
|
||||
'constants passed to {%kMAKEADR} must be typed')
|
||||
ELSE
|
||||
type := GetType(op3) ;
|
||||
tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ;
|
||||
|
@ -2333,7 +2343,7 @@ BEGIN
|
|||
IF CompareTrees(bits, max)>0
|
||||
THEN
|
||||
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 ;
|
||||
PutConst(r, Address) ;
|
||||
AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(Address), val)) ;
|
||||
|
@ -3480,6 +3490,91 @@ BEGIN
|
|||
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
|
||||
binary operator: + - / * and friends. If FALSE
|
||||
|
@ -3489,25 +3584,13 @@ END CodeBinarySet ;
|
|||
|
||||
PROCEDURE BinaryOperands (quad: CARDINAL; l, r: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
tl, tr: CARDINAL ;
|
||||
result: BOOLEAN ;
|
||||
BEGIN
|
||||
result := TRUE ;
|
||||
tl := SkipType(GetType(l)) ;
|
||||
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 ;
|
||||
result := CheckBinaryOperand (quad, TRUE, l, TRUE) ;
|
||||
result := CheckBinaryOperand (quad, FALSE, r, result) ;
|
||||
IF NOT result
|
||||
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 ;
|
||||
RETURN result
|
||||
END BinaryOperands ;
|
||||
|
@ -3535,9 +3618,9 @@ BEGIN
|
|||
SubQuad(quad) ;
|
||||
s := KillString(s)
|
||||
ELSE
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
FoldBinary(tokenno, p, BuildAdd, quad, op1, op2, op3)
|
||||
FoldBinary (tokenno, p, BuildAdd, quad, op1, op2, op3)
|
||||
END
|
||||
END
|
||||
END FoldAdd ;
|
||||
|
@ -3592,7 +3675,7 @@ END CodeAdd ;
|
|||
PROCEDURE FoldSub (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
FoldBinary(tokenno, p, BuildSub, quad, op1, op2, op3)
|
||||
END
|
||||
|
@ -3621,7 +3704,7 @@ END CodeSubChecked ;
|
|||
|
||||
PROCEDURE CodeSubCheck (quad: CARDINAL; left, right: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, left, right)
|
||||
IF BinaryOperands (quad, left, right)
|
||||
THEN
|
||||
CodeBinaryCheck (BuildSubCheck, quad)
|
||||
END
|
||||
|
@ -3634,7 +3717,7 @@ END CodeSubCheck ;
|
|||
|
||||
PROCEDURE CodeSub (quad: CARDINAL; left, right: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, left, right)
|
||||
IF BinaryOperands (quad, left, right)
|
||||
THEN
|
||||
CodeBinary (BuildSub, quad)
|
||||
END
|
||||
|
@ -3648,7 +3731,7 @@ END CodeSub ;
|
|||
PROCEDURE FoldMult (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
FoldBinary(tokenno, p, BuildMult, quad, op1, op2, op3)
|
||||
END
|
||||
|
@ -3776,7 +3859,7 @@ END BinaryOperandRealFamily ;
|
|||
PROCEDURE FoldDivM2 (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||
THEN
|
||||
|
@ -3813,7 +3896,7 @@ END CodeDivM2 ;
|
|||
PROCEDURE FoldModM2 (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
FoldBinary(tokenno, p, BuildModM2, quad, op1, op2, op3)
|
||||
END
|
||||
|
@ -3826,7 +3909,7 @@ END FoldModM2 ;
|
|||
|
||||
PROCEDURE CodeModM2 (quad: CARDINAL; left, right: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, left, right)
|
||||
IF BinaryOperands (quad, left, right)
|
||||
THEN
|
||||
CodeBinary (BuildModM2, quad)
|
||||
END
|
||||
|
@ -3840,7 +3923,7 @@ END CodeModM2 ;
|
|||
PROCEDURE FoldDivTrunc (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||
THEN
|
||||
|
@ -3858,7 +3941,7 @@ END FoldDivTrunc ;
|
|||
|
||||
PROCEDURE CodeDivTrunc (quad: CARDINAL; left, right: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, left, right)
|
||||
IF BinaryOperands (quad, left, right)
|
||||
THEN
|
||||
IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
|
||||
THEN
|
||||
|
@ -3904,7 +3987,7 @@ END CodeModTrunc ;
|
|||
PROCEDURE FoldDivCeil (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||
THEN
|
||||
|
@ -3922,7 +4005,7 @@ END FoldDivCeil ;
|
|||
|
||||
PROCEDURE CodeDivCeil (quad: CARDINAL; left, right: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, left, right)
|
||||
IF BinaryOperands (quad, left, right)
|
||||
THEN
|
||||
IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
|
||||
THEN
|
||||
|
@ -3941,7 +4024,7 @@ END CodeDivCeil ;
|
|||
PROCEDURE FoldModCeil (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
FoldBinary(tokenno, p, BuildModCeil, quad, op1, op2, op3)
|
||||
END
|
||||
|
@ -3968,7 +4051,7 @@ END CodeModCeil ;
|
|||
PROCEDURE FoldDivFloor (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
|
||||
THEN
|
||||
|
@ -4005,7 +4088,7 @@ END CodeDivFloor ;
|
|||
PROCEDURE FoldModFloor (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, op2, op3)
|
||||
IF BinaryOperands (quad, op2, op3)
|
||||
THEN
|
||||
FoldBinary(tokenno, p, BuildModFloor, quad, op1, op2, op3)
|
||||
END
|
||||
|
@ -4018,7 +4101,7 @@ END FoldModFloor ;
|
|||
|
||||
PROCEDURE CodeModFloor (quad: CARDINAL; left, right: CARDINAL) ;
|
||||
BEGIN
|
||||
IF BinaryOperands(quad, left, right)
|
||||
IF BinaryOperands (quad, left, right)
|
||||
THEN
|
||||
CodeBinary (BuildModFloor, quad)
|
||||
END
|
||||
|
@ -4437,7 +4520,7 @@ END FoldBinarySet ;
|
|||
PROCEDURE FoldSetOr (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
FoldBinarySet(tokenno, p, SetOr, quad, op1, op2, op3)
|
||||
FoldBinarySet (tokenno, p, SetOr, quad, op1, op2, op3)
|
||||
END FoldSetOr ;
|
||||
|
||||
|
||||
|
@ -4447,7 +4530,7 @@ END FoldSetOr ;
|
|||
|
||||
PROCEDURE CodeSetOr (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
CodeBinarySet(BuildLogicalOr, SetOr, quad, op1, op2, op3)
|
||||
CodeBinarySet (BuildLogicalOr, SetOr, quad, op1, op2, op3)
|
||||
END CodeSetOr ;
|
||||
|
||||
|
||||
|
@ -4468,7 +4551,7 @@ END FoldSetAnd ;
|
|||
|
||||
PROCEDURE CodeSetAnd (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
CodeBinarySet(BuildLogicalAnd, SetAnd, quad, op1, op2, op3)
|
||||
CodeBinarySet (BuildLogicalAnd, SetAnd, quad, op1, op2, op3)
|
||||
END CodeSetAnd ;
|
||||
|
||||
|
||||
|
@ -4566,12 +4649,12 @@ END FoldSetShift ;
|
|||
|
||||
PROCEDURE CodeSetShift (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
CodeBinarySetShift(BuildLogicalShift,
|
||||
SetShift,
|
||||
MakeKey('ShiftVal'),
|
||||
MakeKey('ShiftLeft'),
|
||||
MakeKey('ShiftRight'),
|
||||
quad, op1, op2, op3)
|
||||
CodeBinarySetShift (BuildLogicalShift,
|
||||
SetShift,
|
||||
MakeKey('ShiftVal'),
|
||||
MakeKey('ShiftLeft'),
|
||||
MakeKey('ShiftRight'),
|
||||
quad, op1, op2, op3)
|
||||
END CodeSetShift ;
|
||||
|
||||
|
||||
|
@ -4592,12 +4675,12 @@ END FoldSetRotate ;
|
|||
|
||||
PROCEDURE CodeSetRotate (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
CodeBinarySetShift(BuildLogicalRotate,
|
||||
SetRotate,
|
||||
MakeKey('RotateVal'),
|
||||
MakeKey('RotateLeft'),
|
||||
MakeKey('RotateRight'),
|
||||
quad, op1, op2, op3)
|
||||
CodeBinarySetShift (BuildLogicalRotate,
|
||||
SetRotate,
|
||||
MakeKey ('RotateVal'),
|
||||
MakeKey ('RotateLeft'),
|
||||
MakeKey ('RotateRight'),
|
||||
quad, op1, op2, op3)
|
||||
END CodeSetRotate ;
|
||||
|
||||
|
||||
|
@ -4620,8 +4703,8 @@ END FoldSetLogicalDifference ;
|
|||
|
||||
PROCEDURE CodeSetLogicalDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
CodeBinarySet(BuildLogicalDifference, SetDifference,
|
||||
quad, op1, op2, op3)
|
||||
CodeBinarySet (BuildLogicalDifference, SetDifference,
|
||||
quad, op1, op2, op3)
|
||||
END CodeSetLogicalDifference ;
|
||||
|
||||
|
||||
|
@ -4632,7 +4715,7 @@ END CodeSetLogicalDifference ;
|
|||
PROCEDURE FoldSymmetricDifference (tokenno: CARDINAL; p: WalkAction;
|
||||
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
FoldBinarySet(tokenno, p, SetSymmetricDifference, quad, op1, op2, op3)
|
||||
FoldBinarySet (tokenno, p, SetSymmetricDifference, quad, op1, op2, op3)
|
||||
END FoldSymmetricDifference ;
|
||||
|
||||
|
||||
|
@ -4642,8 +4725,8 @@ END FoldSymmetricDifference ;
|
|||
|
||||
PROCEDURE CodeSetSymmetricDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
|
||||
BEGIN
|
||||
CodeBinarySet(BuildSymmetricDifference, SetSymmetricDifference,
|
||||
quad, op1, op2, op3)
|
||||
CodeBinarySet (BuildSymmetricDifference, SetSymmetricDifference,
|
||||
quad, op1, op2, op3)
|
||||
END CodeSetSymmetricDifference ;
|
||||
|
||||
|
||||
|
@ -4652,7 +4735,7 @@ END CodeSetSymmetricDifference ;
|
|||
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) ;
|
||||
VAR
|
||||
location: location_t ;
|
||||
|
@ -4669,7 +4752,7 @@ BEGIN
|
|||
Assert (FindType (expr) # NulSym) ;
|
||||
PutConst (result, FindType (expr)) ;
|
||||
PushValue (expr) ;
|
||||
doOp (CurrentQuadToken) ;
|
||||
constop (CurrentQuadToken) ;
|
||||
PopValue (result) ;
|
||||
PushValue (result) ;
|
||||
PutConstSet (result) ;
|
||||
|
@ -4683,10 +4766,10 @@ BEGIN
|
|||
END
|
||||
ELSE
|
||||
checkDeclare (result) ;
|
||||
BuildUnaryForeachWordDo(location,
|
||||
Mod2Gcc (GetType (result)), Mod2Gcc (result), Mod2Gcc (expr), unop,
|
||||
GetMode(result) = LeftValue, GetMode(expr) = LeftValue,
|
||||
IsConst (result), IsConst (expr))
|
||||
BuildUnaryForeachWordDo (location,
|
||||
Mod2Gcc (GetType (result)), Mod2Gcc (result), Mod2Gcc (expr), unop,
|
||||
GetMode(result) = LeftValue, GetMode(expr) = LeftValue,
|
||||
IsConst (result), IsConst (expr))
|
||||
END
|
||||
END CodeUnarySet ;
|
||||
|
||||
|
@ -5195,7 +5278,7 @@ PROCEDURE FoldNegate (tokenno: CARDINAL; p: WalkAction;
|
|||
BEGIN
|
||||
IF IsConstSet (expr)
|
||||
THEN
|
||||
FoldUnarySet(tokenno, p, SetNegate, quad, result, expr)
|
||||
FoldUnarySet (tokenno, p, SetNegate, quad, result, expr)
|
||||
ELSE
|
||||
FoldUnary (tokenno, p, BuildNegate, NIL, quad, result, expr)
|
||||
END
|
||||
|
@ -5212,11 +5295,14 @@ BEGIN
|
|||
IF IsConstSet (op3) OR IsSet (GetType (op3))
|
||||
THEN
|
||||
CodeUnarySet (BuildSetNegate, SetNegate, quad, op1, op3)
|
||||
ELSIF MustCheckOverflow (quad)
|
||||
ELSIF UnaryOperand (quad, op3)
|
||||
THEN
|
||||
CodeUnaryCheck (BuildNegateCheck, NIL, quad, op1, op3)
|
||||
ELSE
|
||||
CodeUnary (BuildNegate, NIL, quad, op1, op3)
|
||||
IF MustCheckOverflow (quad)
|
||||
THEN
|
||||
CodeUnaryCheck (BuildNegateCheck, NIL, quad, op1, op3)
|
||||
ELSE
|
||||
CodeUnary (BuildNegate, NIL, quad, op1, op3)
|
||||
END
|
||||
END
|
||||
END CodeNegateChecked ;
|
||||
|
||||
|
@ -6288,7 +6374,7 @@ BEGIN
|
|||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||
THEN
|
||||
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)
|
||||
ELSE
|
||||
ConvertBinaryOperands(location,
|
||||
|
@ -6385,7 +6471,7 @@ BEGIN
|
|||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||
THEN
|
||||
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)
|
||||
ELSE
|
||||
ConvertBinaryOperands(location,
|
||||
|
@ -6481,7 +6567,7 @@ BEGIN
|
|||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||
THEN
|
||||
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)
|
||||
ELSE
|
||||
ConvertBinaryOperands(location,
|
||||
|
@ -6577,7 +6663,7 @@ BEGIN
|
|||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||
THEN
|
||||
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)
|
||||
ELSE
|
||||
ConvertBinaryOperands(location,
|
||||
|
@ -6731,7 +6817,7 @@ BEGIN
|
|||
IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
|
||||
THEN
|
||||
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)
|
||||
ELSE
|
||||
ConvertBinaryOperands(location,
|
||||
|
@ -6780,7 +6866,7 @@ BEGIN
|
|||
IF IsComposite(op1) OR IsComposite(op2)
|
||||
THEN
|
||||
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)
|
||||
ELSE
|
||||
ConvertBinaryOperands(location,
|
||||
|
|
|
@ -128,6 +128,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
|
|||
GetQuad, GetFirstQuad, GetNextQuad, PutQuad,
|
||||
SubQuad, EraseQuad, GetRealQuad,
|
||||
GetQuadtok, GetQuadOtok,
|
||||
GetQuadOp, GetM2OperatorDesc,
|
||||
CountQuads,
|
||||
GetLastFileQuad,
|
||||
GetLastQuadNo,
|
||||
|
@ -437,6 +438,24 @@ PROCEDURE GetQuad (QuadNo: 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.
|
||||
*)
|
||||
|
|
|
@ -13381,6 +13381,55 @@ BEGIN
|
|||
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.
|
||||
*)
|
||||
|
|
|
@ -186,6 +186,15 @@ BEGIN
|
|||
nb := AddToRange (nb, TRUE, i) ;
|
||||
SetScope (nb, op3, definitionscope)
|
||||
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
|
||||
nb := AddToRange (nb, TRUE, i) ;
|
||||
IF IsDefImp (op3)
|
||||
|
|
|
@ -227,7 +227,7 @@ PROCEDURE BuildAsm (location: location_t; instr: Tree;
|
|||
BuildUnaryForeachWordDo - provides the large set operators.
|
||||
Each word (or less) of the set can be
|
||||
calculated by unop.
|
||||
This procedure runs along each word
|
||||
This procedure iterates over each word
|
||||
of the large set invoking the unop.
|
||||
*)
|
||||
|
||||
|
|
Loading…
Reference in New Issue