From 06642d296d6bfbd736805066b9982905f7015486 Mon Sep 17 00:00:00 2001 From: Gaius Mulley Date: Thu, 11 Aug 2022 18:13:49 +0100 Subject: [PATCH] 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 --- gcc/m2/gm2-compiler/M2GCCDeclare.mod | 12 +- gcc/m2/gm2-compiler/M2GenGCC.mod | 262 ++++++++++++++++++--------- gcc/m2/gm2-compiler/M2Quads.def | 19 ++ gcc/m2/gm2-compiler/M2Quads.mod | 49 +++++ gcc/m2/gm2-compiler/M2Scope.mod | 9 + gcc/m2/gm2-gcc/m2statement.def | 2 +- 6 files changed, 258 insertions(+), 95 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index bcef0f8be56..78e9d86db67 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -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 ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index 44f83ddd21e..5754ef19184 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -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, diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index cebf6ae2158..bd36812fdde 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -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. *) diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 73f6b93d483..ac3cccb61ed 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -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. *) diff --git a/gcc/m2/gm2-compiler/M2Scope.mod b/gcc/m2/gm2-compiler/M2Scope.mod index f085dd65293..146ecd12522 100644 --- a/gcc/m2/gm2-compiler/M2Scope.mod +++ b/gcc/m2/gm2-compiler/M2Scope.mod @@ -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) diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def index 9138d826dac..ceeb5582c32 100644 --- a/gcc/m2/gm2-gcc/m2statement.def +++ b/gcc/m2/gm2-gcc/m2statement.def @@ -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. *)