IsAssignmentCompatible,
IsExpressionCompatible,
IsParameterCompatible,
+ IsComparisonCompatible,
IsValidParameter,
AssignmentRequiresWarning,
IsMathType,
PROCEDURE IsParameterCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+(*
+ IsComparisonCompatible - returns TRUE if t1 and t2 are comparison
+ compatible. PIM allows INTEGER and ADDRESS within
+ expressions but we warn against their comparison.
+*)
+
+PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+
+
(*
IsValidParameter - returns TRUE if an, actual, parameter can be passed
to the, formal, parameter. This differs from
TYPE
- Compatability = (expression, assignment, parameter) ;
+ Compatability = (expression, assignment, parameter, comparison) ;
MetaType = (const, word, byte, address, chr,
normint, shortint, longint,
normcard, shortcard, longcard,
CompatibilityArray = ARRAY MetaType, MetaType OF Compatible ;
VAR
+ Comp,
Expr,
Ass : CompatibilityArray ;
Ord,
expression: MetaError2('{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in an expression, hint one of the expressions should be converted', t1, t2) |
assignment: MetaError2('{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} during an assignment, hint maybe the expression should be converted', t1, t2) |
- parameter : MetaError2('{%1W:} type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} {%2as}}}, hint the actual parameter {%2a} should be converted', t1, t2)
+ parameter : MetaError2('{%1W:} type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} {%2as}}}, hint the actual parameter {%2a} should be converted', t1, t2) |
+ comparison: MetaError2('{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in a relational expression, hint one of the expressions should be converted', t1, t2)
ELSE
END
expression: MetaError2('type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in an expression, hint one of the expressions should be converted', t1, t2) |
assignment: MetaError2('type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} during an assignment, hint maybe the expression should be converted', t1, t2) |
- parameter : MetaError2('type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} and {%2as}}}, hint the actual parameter should be converted', t1, t2)
+ parameter : MetaError2('type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} and {%2as}}}, hint the actual parameter should be converted', t1, t2) |
+ comparison: MetaError2('type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in a relational expression, hint one of the expressions should be converted', t1, t2)
ELSE
END
s: String ;
r: Compatible ;
BEGIN
- r := IsCompatible(t1, t2, kind) ;
+ r := IsCompatible (t1, t2, kind) ;
IF (r#first) AND (r#second)
THEN
IF (r=warnfirst) OR (r=warnsecond)
expression: RETURN( Expr [mt1, mt2] ) |
assignment: RETURN( Ass [mt1, mt2] ) |
- parameter : RETURN( Ass [mt1, mt2] )
+ parameter : RETURN( Ass [mt1, mt2] ) |
+ comparison: RETURN( Comp [mt1, mt2] )
ELSE
- InternalError ('unexpected Compatibility')
+ InternalError ('unexpected compatibility')
END
END
END IsBaseCompatible ;
PROCEDURE IsCompatible (t1, t2: CARDINAL; kind: Compatability) : Compatible ;
BEGIN
- t1 := SkipType(t1) ;
- t2 := SkipType(t2) ;
+ t1 := SkipType (t1) ;
+ t2 := SkipType (t2) ;
IF t1 = t2
THEN
(* same types are always compatible. *)
RETURN first
- ELSIF IsPassCodeGeneration()
+ ELSIF IsPassCodeGeneration ()
THEN
- RETURN( AfterResolved(t1, t2, kind) )
+ RETURN AfterResolved (t1, t2, kind)
ELSE
- RETURN( BeforeResolved(t1, t2, kind) )
+ RETURN BeforeResolved (t1, t2, kind)
END
END IsCompatible ;
END IsParameterCompatible ;
+(*
+ IsComparisonCompatible - returns TRUE if t1 and t2 are comparison compatible.
+*)
+
+PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ;
+BEGIN
+ RETURN(
+ (IsCompatible(t1, t2, comparison)=first) OR
+ (IsCompatible(t1, t2, comparison)=second)
+ )
+END IsComparisonCompatible ;
+
+
(*
MixMetaTypes -
*)
PROCEDURE A (y: MetaType; a: ARRAY OF CHAR) ;
BEGIN
- InitArray(Ass, y, a)
+ InitArray (Ass, y, a)
END A ;
PROCEDURE E (y: MetaType; a: ARRAY OF CHAR) ;
BEGIN
- InitArray(Expr, y, a)
+ InitArray (Expr, y, a)
END E ;
+(*
+ C - initialize the comparision array
+*)
+
+PROCEDURE C (y: MetaType; a: ARRAY OF CHAR) ;
+BEGIN
+ InitArray (Comp, y, a)
+END C ;
+
+
(*
InitCompatibilityMatrices - initializes the tables above.
*)
E(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ;
E(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F') ;
+ (* Comparison compatibility *)
+
+
+ (*
+ 1 p w
+
+ N W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A
+ u o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r
+ l r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r
+ S d e r r e r g d r g m l r g q p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p a
+ y e g t i i t c t r u e e 6 2 4 8 1 3 6 1 3 6 3 6 9 1 6 2 l t C l l l l e y
+ m s e i n n c a r e e 6 2 4 6 2 4 2 4 6 2 e C o e e e e
+ s r n t a a r e a 8 x o m x x x x
+ t l r d a l m p 3 6 9 1
+ d l p l 2 4 6 2
+ l e 8
+ e x
+ x
+ ------------------------------------------------------------------------------------------------------------
+ 2
+ P
+ W
+ *)
+
+ C(const , 'T T T T T T T T T T T T T T T T T T F F T T T T T T T T T T T T T T T T F F F F F F F F F F F F F') ;
+ C(word , '. T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(byte , '. . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(address , '. . . T F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(chr , '. . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(normint , '. . . . . T F F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(shortint , '. . . . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(longint , '. . . . . . . T F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(normcard , '. . . . . . . . T F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(shortcard , '. . . . . . . . . T F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(longcard , '. . . . . . . . . . T F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(pointer , '. . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(enum , '. . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(real , '. . . . . . . . . . . . . T F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(shortreal , '. . . . . . . . . . . . . . T F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(longreal , '. . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(set , '. . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(opaque , '. . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(loc , '. . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(rtype , '. . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F') ;
+ C(ztype , '. . . . . . . . . . . . . . . . . . . . T 1 1 1 1 1 1 1 1 1 1 1 F F F F F F F F F F F F F F F F F') ;
+ C(int8 , '. . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(int16 , '. . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(int32 , '. . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(int64 , '. . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(card8 , '. . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(card16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F') ;
+ C(card32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F') ;
+ C(card64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F') ;
+ C(word16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F') ;
+ C(word32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F') ;
+ C(word64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F') ;
+ C(real32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ;
+ C(real64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ;
+ C(real96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ;
+ C(real128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ;
+ C(set8 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ;
+ C(set16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ;
+ C(set32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F') ;
+ C(complex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F') ;
+ C(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F') ;
+ C(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F') ;
+ C(complex32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F') ;
+ C(complex64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F') ;
+ C(complex96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F') ;
+ C(complex128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F') ;
+ C(ctype , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F') ;
+ C(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ;
+ C(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F') ;
+
END InitCompatibilityMatrices ;
*)
PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
- left, right: CARDINAL) : BOOLEAN ;
+ left, right: CARDINAL;
+ strict, isin: BOOLEAN) : BOOLEAN ;
END M2Check.
*)
FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ;
-FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType ;
+FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType ;
FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex ;
FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ;
procedure,
nth : CARDINAL ;
isvar : BOOLEAN ;
+ strict : BOOLEAN ; (* Comparison expression. *)
+ isin : BOOLEAN ; (* Expression created by IN? *)
error : Error ;
checkFunc : typeCheckFunction ;
visited,
END |
assignment: RETURN issueError (IsAssignmentCompatible (left, right),
tinfo, left, right) |
- expression: RETURN issueError (IsExpressionCompatible (left, right),
- tinfo, left, right)
+ expression: IF tinfo^.isin
+ THEN
+ IF IsVar (right) OR IsConst (right)
+ THEN
+ right := GetSType (right)
+ END
+ END ;
+ IF tinfo^.strict
+ THEN
+ RETURN issueError (IsComparisonCompatible (left, right),
+ tinfo, left, right)
+ ELSE
+ RETURN issueError (IsExpressionCompatible (left, right),
+ tinfo, left, right)
+ END
ELSE
InternalError ('unexpected kind value')
tinfo^.resolved := InitIndex (1) ;
tinfo^.unresolved := InitIndex (1) ;
include (tinfo^.unresolved, des, expr, unknown) ;
+ tinfo^.strict := FALSE ;
+ tinfo^.isin := FALSE ;
IF doCheck (tinfo)
THEN
deconstruct (tinfo) ;
tinfo^.visited := InitIndex (1) ;
tinfo^.resolved := InitIndex (1) ;
tinfo^.unresolved := InitIndex (1) ;
+ tinfo^.strict := FALSE ;
+ tinfo^.isin := FALSE ;
include (tinfo^.unresolved, actual, formal, unknown) ;
IF doCheck (tinfo)
THEN
(*
- ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
- are expression compatible.
+ doExpressionTypeCompatible -
*)
-PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
- left, right: CARDINAL) : BOOLEAN ;
+PROCEDURE doExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+ left, right: CARDINAL;
+ strict: BOOLEAN) : BOOLEAN ;
VAR
tinfo: tInfo ;
BEGIN
tinfo^.visited := InitIndex (1) ;
tinfo^.resolved := InitIndex (1) ;
tinfo^.unresolved := InitIndex (1) ;
+ tinfo^.strict := strict ;
+ tinfo^.isin := FALSE ;
include (tinfo^.unresolved, left, right, unknown) ;
IF doCheck (tinfo)
THEN
deconstruct (tinfo) ;
RETURN FALSE
END
+END doExpressionTypeCompatible ;
+
+
+(*
+ ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
+ are expression compatible.
+*)
+
+PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+ left, right: CARDINAL;
+ strict, isin: BOOLEAN) : BOOLEAN ;
+BEGIN
+ IF (left#NulSym) AND (right#NulSym)
+ THEN
+ IF isin
+ THEN
+ IF IsConst (right) OR IsVar (right)
+ THEN
+ right := GetSType (right)
+ END ;
+ IF IsSet (right)
+ THEN
+ right := GetSType (right)
+ END
+ END
+ END ;
+ RETURN doExpressionTypeCompatible (token, format, left, right, strict)
END ExpressionTypeCompatible ;
PROCEDURE TryDeclareConstructor (tokenno: CARDINAL; sym: CARDINAL) ;
BEGIN
- IF sym=NulSym
+ IF sym#NulSym
THEN
- InternalError ('trying to declare the NulSym')
- END ;
- IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym))
- THEN
- WalkConstructor(sym, TraverseDependants) ;
- IF NOT IsElementInSet(ToBeSolvedByQuads, sym)
+ IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym))
THEN
- TryEvaluateValue(sym) ;
- IF IsConstructorDependants(sym, IsFullyDeclared)
+ WalkConstructor(sym, TraverseDependants) ;
+ IF NOT IsElementInSet(ToBeSolvedByQuads, sym)
THEN
- PushValue(sym) ;
- DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
+ TryEvaluateValue(sym) ;
+ IF IsConstructorDependants(sym, IsFullyDeclared)
+ THEN
+ PushValue(sym) ;
+ DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
+ END
END
END
END
THEN
printf0(' constant constructor set ') ;
IncludeType(l, sym)
- END ;
+ ELSE
+ IncludeType(l, sym)
+ END
ELSIF IsConstructor(sym)
THEN
printf2('sym %d IsConstructor (non constant) (%a)', sym, n) ;
FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaError3,
MetaErrors1, MetaErrors2, MetaErrors3,
MetaErrorT0, MetaErrorT1, MetaErrorT2,
+ MetaErrorsT1,
MetaErrorStringT0, MetaErrorStringT1,
MetaErrorString1, MetaErrorString2,
MetaErrorN1, MetaErrorN2,
n1, n2)
ELSE
(* this checks the types are compatible, not the data contents. *)
- BuildRange(InitTypesAssignmentCheck(tokno, currentProc, actualVal))
+ BuildRange (InitTypesAssignmentCheck (tokno, currentProc, actualVal))
END
END CheckReturnType ;
ELSE
OldPos := OperatorPos ;
OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
- (*
- IF checkTypes
- THEN
- CheckExpressionCompatible (lefttype, righttype) ;
- IF CannotCheckTypeInPass3 (left) OR CannotCheckTypeInPass3 (right)
- THEN
- BuildRange (InitTypesExpressionCheck (OperatorPos, left, right))
- END
- END ;
- *)
IF checkTypes
THEN
- BuildRange (InitTypesExpressionCheck (OperatorPos, left, right))
+ BuildRange (InitTypesExpressionCheck (OperatorPos, left, right, FALSE, FALSE))
END ;
value := MakeTemporaryFromExpressions (OperatorPos,
right, left,
CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure.
*)
-PROCEDURE CheckVariableOrConstantOrProcedure (sym: CARDINAL) ;
+PROCEDURE CheckVariableOrConstantOrProcedure (tokpos: CARDINAL; sym: CARDINAL) ;
VAR
type: CARDINAL ;
BEGIN
type := GetSType (sym) ;
IF IsUnknown (sym)
THEN
- MetaError1 ('{%1EUad} has not been declared', sym) ;
+ MetaErrorT1 (tokpos, '{%1EUad} has not been declared', sym) ;
UnknownReported (sym)
+ ELSIF IsPseudoSystemFunction (sym) OR IsPseudoBaseFunction (sym)
+ THEN
+ MetaErrorT1 (tokpos,
+ '{%1Ead} expected a variable, procedure, constant or expression, not an intrinsic procedure function',
+ sym)
ELSIF (NOT IsConst(sym)) AND (NOT IsVar(sym)) AND
(NOT IsProcedure(sym)) AND
(NOT IsTemporary(sym)) AND (NOT MustNotCheckBounds)
THEN
- MetaErrors1 ('{%1Ead} expected a variable, procedure, constant or expression',
- 'and it was declared as a {%1Dd}', sym) ;
+ MetaErrorsT1 (tokpos,
+ '{%1Ead} expected a variable, procedure, constant or expression',
+ 'and it was declared as a {%1Dd}', sym) ;
ELSIF (type#NulSym) AND IsArray(type)
THEN
- MetaErrors1 ('{%1EU} not expecting an array variable as an operand for either comparison or binary operation',
- 'it was declared as a {%1Dd}', sym)
+ MetaErrorsT1 (tokpos,
+ '{%1EU} not expecting an array variable as an operand for either comparison or binary operation',
+ 'it was declared as a {%1Dd}', sym)
ELSIF IsConstString(sym) AND (GetStringLength(sym)>1)
THEN
- MetaError1 ('{%1EU} not expecting a string constant as an operand for either comparison or binary operation',
- sym)
+ MetaErrorT1 (tokpos,
+ '{%1EU} not expecting a string constant as an operand for either comparison or binary operation',
+ sym)
END
END CheckVariableOrConstantOrProcedure ;
PROCEDURE BuildRelOp (optokpos: CARDINAL) ;
VAR
combinedTok,
- tokpos1,
- tokpos2 : CARDINAL ;
- Op : Name ;
+ rightpos,
+ leftpos : CARDINAL ;
+ Op : Name ;
t,
- t1, t2,
- e1, e2 : CARDINAL ;
+ rightType, leftType,
+ right, left : CARDINAL ;
BEGIN
IF CompilerDebugging
THEN
THEN
ConvertBooleanToVariable (OperandTtok (3), 3)
END ;
- PopTFtok (e1, t1, tokpos1) ;
+ PopTFtok (right, rightType, rightpos) ;
PopT (Op) ;
- PopTFtok (e2, t2, tokpos2) ;
+ PopTFtok (left, leftType, leftpos) ;
- CheckVariableOrConstantOrProcedure (e1) ;
- CheckVariableOrConstantOrProcedure (e2) ;
+ CheckVariableOrConstantOrProcedure (rightpos, right) ;
+ CheckVariableOrConstantOrProcedure (leftpos, left) ;
- IF (Op = EqualTok) OR (Op = HashTok) OR (Op = LessGreaterTok)
+ IF (left#NulSym) AND (right#NulSym)
THEN
- CheckAssignmentCompatible (t1, t2)
- ELSE
- IF IsConstructor (e1) OR IsConstSet (e1)
- THEN
- (* ignore type checking for now *)
- ELSE
- t1 := CheckInCompatible (Op, t2, t1) ;
- CheckExpressionCompatible (t1, t2)
- END
+ (* BuildRange will check the expression later on once gcc knows about all data types. *)
+ BuildRange (InitTypesExpressionCheck (optokpos, left, right, TRUE, Op = InTok))
END ;
- (* must dereference LeftValue operands *)
- IF GetMode(e1) = LeftValue
+ (* Must dereference LeftValue operands. *)
+ IF GetMode(right) = LeftValue
THEN
- t := MakeTemporary (tokpos1, RightValue) ;
- PutVar(t, GetSType(e1)) ;
- CheckPointerThroughNil (tokpos1, e1) ;
- doIndrX (tokpos1, t, e1) ;
- e1 := t
+ t := MakeTemporary (rightpos, RightValue) ;
+ PutVar(t, GetSType(right)) ;
+ CheckPointerThroughNil (rightpos, right) ;
+ doIndrX (rightpos, t, right) ;
+ right := t
END ;
- IF GetMode(e2) = LeftValue
+ IF GetMode(left) = LeftValue
THEN
- t := MakeTemporary (tokpos2, RightValue) ;
- PutVar (t, GetSType (e2)) ;
- CheckPointerThroughNil (tokpos2, e2) ;
- doIndrX (tokpos2, t, e2) ;
- e2 := t
+ t := MakeTemporary (leftpos, RightValue) ;
+ PutVar (t, GetSType (left)) ;
+ CheckPointerThroughNil (leftpos, left) ;
+ doIndrX (leftpos, t, left) ;
+ left := t
END ;
- combinedTok := MakeVirtualTok (optokpos, tokpos2, tokpos1) ;
- GenQuadO (combinedTok, MakeOp(Op), e2, e1, 0, FALSE) ; (* True Exit *)
+ combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ;
+ GenQuadO (combinedTok, MakeOp(Op), left, right, 0, FALSE) ; (* True Exit *)
GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *)
PushBool (NextQuad-2, NextQuad-1)
END
t, f: CARDINAL ;
BEGIN
CheckBooleanId ;
- PopBool(t, f) ;
- PushBool(f, t)
+ PopBool (t, f) ;
+ PushBool (f, t)
END BuildNot ;
are expression compatible.
*)
-PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL;
+ strict, isin: BOOLEAN) : CARDINAL ;
(*
exprLowestType: CARDINAL ;
procedure : CARDINAL ;
paramNo : CARDINAL ;
- isLeftValue : BOOLEAN ; (* is des an LValue,
- only used in pointernil *)
+ isLeftValue : BOOLEAN ; (* is des an LValue,
+ only used in pointernil *)
dimension : CARDINAL ;
caseList : CARDINAL ;
tokenNo : CARDINAL ;
- firstmention : BOOLEAN ; (* error message reported yet? *)
+ errorReported : BOOLEAN ; (* error message reported yet? *)
+ strict : BOOLEAN ; (* is it a comparison expression? *)
+ isin : BOOLEAN ; (* expression created by IN operator? *)
END ;
dimension := 0 ;
caseList := 0 ;
tokenNo := 0 ; (* than pointernil *)
- firstmention := TRUE
+ errorReported := FALSE
END ;
PutIndice(RangeIndex, r, p)
END ;
(*
- FirstMention - returns whether this is the first time this error has been
- reported.
+ reportedError - returns whether this is the first time this error has been
+ reported.
*)
-PROCEDURE FirstMention (r: CARDINAL) : BOOLEAN ;
+PROCEDURE reportedError (r: CARDINAL) : BOOLEAN ;
VAR
p: Range ;
BEGIN
- p := GetIndice(RangeIndex, r) ;
- WITH p^ DO
- IF firstmention
- THEN
- firstmention := FALSE ;
- RETURN( TRUE )
- ELSE
- RETURN( FALSE )
- END
- END
-END FirstMention ;
+ p := GetIndice (RangeIndex, r) ;
+ RETURN p^.errorReported
+END reportedError ;
(*
- Mentioned - returns whether this error has been been reported.
+ setReported - assigns errorReported to TRUE.
*)
-PROCEDURE Mentioned (r: CARDINAL) : BOOLEAN ;
+PROCEDURE setReported (r: CARDINAL) ;
VAR
p: Range ;
BEGIN
- p := GetIndice(RangeIndex, r) ;
- WITH p^ DO
- RETURN NOT firstmention
- END
-END Mentioned ;
+ p := GetIndice (RangeIndex, r) ;
+ p^.errorReported := TRUE
+END setReported ;
(*
expr := e ;
desLowestType := GetLowestType (d) ;
exprLowestType := GetLowestType (e) ;
- tokenNo := tokno
+ tokenNo := tokno ;
+ strict := FALSE ;
+ isin := FALSE
END ;
RETURN p
END PutRange ;
desLowestType := NulSym ;
exprLowestType := NulSym ;
isLeftValue := FALSE ;
- tokenNo := chooseTokenPos (tokpos)
+ tokenNo := chooseTokenPos (tokpos) ;
+ strict := FALSE ;
+ isin := FALSE
END ;
- RETURN( p )
+ RETURN p
END PutRangeNoLow ;
+(*
+ PutRangeExpr - initializes contents of, p. It
+ does not set lowest types as they may be
+ unknown at this point.
+*)
+
+PROCEDURE PutRangeExpr (tokpos: CARDINAL; p: Range; t: TypeOfRange;
+ d, e: CARDINAL; strict, isin: BOOLEAN) : Range ;
+BEGIN
+ WITH p^ DO
+ type := t ;
+ des := d ;
+ expr := e ;
+ desLowestType := NulSym ;
+ exprLowestType := NulSym ;
+ isLeftValue := FALSE ;
+ tokenNo := chooseTokenPos (tokpos) ;
+ END ;
+ p^.strict := strict ;
+ p^.isin := isin ;
+ RETURN p
+END PutRangeExpr ;
+
+
(*
PutRangePointer - initializes contents of, p, to
d, isLeft and their lowest types.
desLowestType := GetLowestType(GetType(d)) ;
exprLowestType := NulSym ;
isLeftValue := isLeft ;
- tokenNo := tokpos
+ tokenNo := tokpos ;
+ strict := FALSE ;
+ isin := FALSE
END ;
- RETURN( p )
+ RETURN p
END PutRangePointer ;
desLowestType := GetLowestType(d) ;
exprLowestType := NulSym ;
isLeftValue := FALSE ;
- tokenNo := chooseTokenPos (tokno)
+ tokenNo := chooseTokenPos (tokno) ;
+ strict := FALSE ;
+ isin := FALSE
END ;
RETURN( p )
END PutRangeUnary ;
procedure := proc ;
paramNo := i ;
isLeftValue := FALSE ;
- tokenNo := GetTokenNo ()
+ tokenNo := GetTokenNo () ;
+ strict := FALSE ;
+ isin := FALSE
END ;
RETURN p
END PutRangeParam ;
desLowestType := GetLowestType(d) ;
exprLowestType := GetLowestType(e) ;
dimension := dim ;
- tokenNo := GetTokenNo ()
+ tokenNo := GetTokenNo () ;
+ strict := FALSE ;
+ isin := FALSE
END ;
RETURN p
END PutRangeArraySubscript ;
are expression compatible.
*)
-PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL; strict, isin: BOOLEAN) : CARDINAL ;
VAR
r: CARDINAL ;
BEGIN
r := InitRange() ;
- Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeexpr, d, e) # NIL) ;
+ Assert (PutRangeExpr (tokno, GetIndice (RangeIndex, r), typeexpr, d, e, strict, isin) # NIL) ;
RETURN r
END InitTypesExpressionCheck ;
IF TreeOverflow (max)
THEN
WriteString ("overflow detected in expr\n"); WriteLn ;
- debug_tree (StringToChar(Mod2Gcc(expr), type, expr));
+ debug_tree (StringToChar (Mod2Gcc (expr), type, expr));
END ;
PushIntegerTree (StringToChar (Mod2Gcc (expr), type, expr)) ;
PushIntegerTree (min) ;
p : Range ;
min, max: Tree ;
BEGIN
- p := GetIndice(RangeIndex, r) ;
+ p := GetIndice (RangeIndex, r) ;
WITH p^ DO
- TryDeclareConstant(tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *)
- IF desLowestType#NulSym
+ TryDeclareConstant (tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *)
+ IF desLowestType # NulSym
THEN
- IF GccKnowsAbout(expr) AND IsConst(expr) AND
- GetMinMax(tokenno, desLowestType, min, max)
+ IF GccKnowsAbout (expr) AND IsConst (expr) AND
+ GetMinMax (tokenno, desLowestType, min, max)
THEN
- IF OutOfRange(tokenno, min, expr, max, desLowestType)
+ IF OutOfRange (tokenno, min, expr, max, desLowestType)
THEN
- MetaErrorT2(tokenNo,
- 'attempting to assign a value {%2Wa} to a designator {%1a} which will exceed the range of type {%1tad}',
- des, expr) ;
- PutQuad(q, ErrorOp, NulSym, NulSym, r)
+ MetaErrorT2 (tokenNo,
+ 'attempting to assign a value {%2Wa} to a designator {%1a} which will exceed the range of type {%1tad}',
+ des, expr) ;
+ PutQuad (q, ErrorOp, NulSym, NulSym, r)
ELSE
- SubQuad(q)
+ SubQuad (q)
END
END
END
exprType := GetType(expr)
END ;
- IF IsAssignmentCompatible(GetType(des), exprType)
+ IF IsAssignmentCompatible (GetType(des), exprType)
THEN
SubQuad(q)
ELSE
- IF FirstMention(r)
+ IF NOT reportedError (r)
THEN
- IF IsProcedure(des)
+ IF IsProcedure (des)
THEN
- MetaErrorsT2(tokenNo,
- 'the return type {%1Etad} declared in procedure {%1Da}',
- 'is incompatible with the returned expression {%2ad}}',
- des, expr) ;
+ MetaErrorsT2 (tokenNo,
+ 'the return type {%1Etad} declared in procedure {%1Da}',
+ 'is incompatible with the returned expression {%2ad}}',
+ des, expr) ;
ELSE
- MetaErrorT3(tokenNo,
- 'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%3ad:of type {%3ad}} are incompatible',
- des, expr, exprType)
+ MetaErrorT3 (tokenNo,
+ 'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%3ad:of type {%3ad}} are incompatible',
+ des, expr, exprType)
END ;
+ setReported (r) ;
FlushErrors
END
END
procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo))
THEN
SubQuad(q)
- ELSE
- (*
- IF FirstMention(r)
- THEN
- MetaErrorsT4(tokenNo,
- '{%3EN} actual parameter {%2ad} is incompatible with the formal parameter {%1ad}',
- '{%3EN} parameter in procedure {%4Da}',
- formal, actual, paramNo, procedure) ;
- (* FlushErrors *)
- END
- *)
END
END FoldTypeParam ;
FoldTypeExpr -
*)
-PROCEDURE FoldTypeExpr (q: CARDINAL; tokenNo: CARDINAL; left, right: CARDINAL; r: CARDINAL) ;
+PROCEDURE FoldTypeExpr (q: CARDINAL; tokenNo: CARDINAL; left, right: CARDINAL; strict, isin: BOOLEAN; r: CARDINAL) ;
BEGIN
- IF NOT Mentioned (r)
+ IF (left # NulSym) AND (right # NulSym) AND (NOT reportedError (r))
THEN
IF ExpressionTypeCompatible (tokenNo,
'expression of type {%1Etad} is incompatible with type {%2tad}',
- left, right)
- (* IsExpressionCompatible(GetType(des), GetType(expr)) *)
+ left, right, strict, isin)
THEN
- SubQuad(q)
- ELSE
- IF FirstMention (r)
- THEN
- MetaErrorT2 (tokenNo,
- 'expression of type {%1Etad} is incompatible with type {%2tad}',
- left, right)
- END
+ SubQuad(q) ;
+ setReported (r)
END
- (* FlushErrors *)
END
END FoldTypeExpr ;
END ;
IF NOT IsAssignmentCompatible(GetType(des), exprType)
THEN
- IF FirstMention(r)
+ IF NOT reportedError (r)
THEN
IF IsProcedure(des)
THEN
MetaErrorT2(tokenNo,
'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible',
des, expr)
- END
+ END ;
+ setReported (r)
END
(* FlushErrors *)
END
'{%4EN} type failure between actual {%3ad} and the formal {%2ad}',
procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo))
THEN
- (*
- IF FirstMention(r)
- THEN
- MetaErrorsT4(tokenNo,
- '{%3EN} type failure between actual parameter {%2ad} and the formal parameter {%1ad}',
- '{%3EN} parameter of procedure {%4Da} {%1a} has a type of {%1ad}',
- formal, actual, paramNo, procedure) ;
- (* FlushErrors *)
- END
- *)
END
END CodeTypeParam ;
CodeTypeExpr -
*)
-PROCEDURE CodeTypeExpr (tokenNo: CARDINAL; left, right: CARDINAL; r: CARDINAL) ;
+PROCEDURE CodeTypeExpr (tokenNo: CARDINAL; left, right: CARDINAL; strict, isin: BOOLEAN; r: CARDINAL) ;
BEGIN
- IF NOT Mentioned (r)
+ IF NOT reportedError (r)
THEN
- IF NOT ExpressionTypeCompatible (tokenNo,
- 'expression of type {%1Etad} is incompatible with type {%2tad}',
- left, right)
+ IF ExpressionTypeCompatible (tokenNo,
+ 'expression of type {%1Etad} is incompatible with type {%2tad}',
+ left, right, strict, isin)
THEN
- (* IF NOT IsExpressionCompatible(GetType(des), GetType(expr)) *)
- IF FirstMention(r)
- THEN
- MetaErrorT2 (tokenNo,
- 'expression of type {%1Etad} is incompatible with type {%2tad}',
- left, right)
- (* FlushErrors *)
- END
+ setReported (r)
END
END
END CodeTypeExpr ;
typeassign: FoldTypeAssign(q, tokenNo, des, expr, r) |
typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo) |
- typeexpr: FoldTypeExpr(q, tokenNo, des, expr, r)
+ typeexpr: FoldTypeExpr(q, tokenNo, des, expr, strict, isin, r)
ELSE
InternalError ('not expecting to reach this point')
typeassign: CodeTypeAssign(tokenNo, des, expr, r) |
typeparam: CodeTypeParam(tokenNo, des, expr, procedure, paramNo) |
- typeexpr: CodeTypeExpr(tokenNo, des, expr, r)
+ typeexpr: CodeTypeExpr(tokenNo, des, expr, strict, isin, r)
ELSE
InternalError ('not expecting to reach this point')
needsLong, needsUnsigned)
END ;
s := KillString (s) ;
+(*
IF needsLong AND needsUnsigned
THEN
RETURN LongCard
THEN
RETURN LongInt
END ;
+*)
RETURN ZType
END
END GetConstLitType ;
VAR
ch: CHAR ;
BEGIN
- CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, SIZE(ch), ADR(ch))=SIZE(ch)
+ CheckAccess (f, openedforread, FALSE) ;
+ IF BufferedRead (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
THEN
- SetEndOfLine(f, ch) ;
- RETURN( ch )
+ SetEndOfLine (f, ch) ;
+ RETURN ch
ELSE
- RETURN( nul )
+ RETURN nul
END
END ReadChar ;
PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, HIGH(a), ADR(a))=HIGH(a)
+ IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
THEN
SetEndOfLine(f, a[HIGH(a)])
END
PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
- CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite(f, HIGH(a), ADR(a))=HIGH(a)
+ CheckAccess (f, openedforwrite, TRUE) ;
+ IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
THEN
END
END WriteAny ;
PROCEDURE WriteChar (f: File; ch: CHAR) ;
BEGIN
- CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite(f, SIZE(ch), ADR(ch))=SIZE(ch)
+ CheckAccess (f, openedforwrite, TRUE) ;
+ IF BufferedWrite (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
THEN
END
END WriteChar ;
prevpos: INTEGER ;
result : String ;
BEGIN
- IF (startpos = Length (fmt)) OR (startpos < 0)
+ IF (startpos = VAL (INTEGER, Length (fmt))) OR (startpos < 0)
THEN
RETURN s
ELSE
MODULE align3 ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
FROM libc IMPORT exit ;
VAR
x : CHAR ;
z : ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ;
BEGIN
- IF ADR(z) MOD 1024=0
+ IF ADR(z) MOD 1024 = ADDRESS (0)
THEN
- IF ADR(z[1]) MOD 1024#0
+ IF ADR(z[1]) MOD 1024 # ADDRESS (0)
THEN
exit(0)
ELSE
MODULE align4 ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
FROM libc IMPORT exit ;
VAR
x : CHAR ;
z : POINTER TO INTEGER <* bytealignment(1024) *> ;
BEGIN
- IF ADR(z) MOD 1024=0
+ IF ADR(z) MOD 1024 = ADDRESS (0)
THEN
exit(0)
ELSE
MODULE align5 ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
FROM libc IMPORT exit ;
TYPE
VAR
r: rec ;
BEGIN
- IF ADR(r.y) MOD 1024=0
+ IF ADR(r.y) MOD 1024 = ADDRESS (0)
THEN
exit(0)
ELSE
MODULE align6 ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
FROM libc IMPORT exit ;
VAR
x: CHAR ;
y: CHAR <* bytealignment(1024) *> ;
BEGIN
- IF ADR(y) MOD 1024=0
+ IF ADR(y) MOD 1024 = ADDRESS(0)
THEN
exit(0)
ELSE
MODULE align7 ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
FROM libc IMPORT exit ;
TYPE
x : CHAR ;
z : foo ;
BEGIN
- IF ADR(z) MOD 1024=0
+ IF ADR(z) MOD 1024 = ADDRESS(0)
THEN
exit(0)
ELSE
io.in2:=198; (* or set in2 to 0 and it works *)
io.out:=io.in;
- IF io.out#io.in
+ io.in2:=io.in;
+ IF io.in2 # io.in
THEN
exit(1)
END
PROCEDURE assert (b: BOOLEAN; a: ARRAY OF CHAR) ;
BEGIN
- INC(test) ;
+ INC (test) ;
IF NOT b
THEN
printf ("failed test %d which was %a\n", ADR(a)) ;
THEN
w := c ;
i := w ;
- assert (i=c, "copying data through WORD32")
+ assert (CARDINAL(i) = c, "copying data through WORD32")
END ;
w := 1 ;
Close(StdOut) ;
exit(1)
END ;
- IF DIFADR(a2, a1)#TSIZE(LOC)
+ IF DIFADR(a2, a1) # INTEGER (TSIZE (LOC))
THEN
Close(StdOut) ;
exit(2)
END ;
- a1 := MAKEADR(ADDRESS(0)) ;
+ a1 := MAKEADR (ADDRESS (0)) ;
IF a1#NIL
THEN
Close(StdOut) ;
(* inc can never cause an underflow given its range *)
ELSE
(* des <= MAX(INTEGER) *)
- IF des=MIN(INTEGER)
+ IF des = CARDINAL (MAX (INTEGER))
THEN
printf("increment exceeds range at end of FOR loop\n") ;
exit (4)
VAR
e: enumType ;
- i: INTEGER ;
+ i: CARDINAL ;
a: arrayType ;
BEGIN
res := 0 ;
END ;
i := 1 ;
FOR e := one TO lastEnum DO
- Assert(ORD(e)=i, __FILE__, __LINE__, 'enum against a value') ;
- INC(i)
+ Assert (ORD (e) = i, __FILE__, __LINE__, 'enum against a value') ;
+ INC (i)
END ;
exit(res)
END EnumTest.
VAR
l: LONGCARD ;
BEGIN
- (* test for assignment of MAX(LONGINT) *)
+ (* test for assignment of MAX (LONGINT). *)
l := 9223372036854775807 ;
- IF l#9223372036854775807
+ IF l # 9223372036854775807
THEN
- exit(1)
+ exit (1)
END
END TestLong2.
ch: CHAR ;
BEGIN
CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, SIZE(ch), ADR(ch))=SIZE(ch)
+ IF BufferedRead(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
THEN
SetEndOfLine(f, ch) ;
RETURN( ch )
PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, HIGH(a), ADR(a))=HIGH(a)
+ IF BufferedRead(f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
THEN
SetEndOfLine(f, a[HIGH(a)])
END
PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite(f, HIGH(a), ADR(a))=HIGH(a)
+ IF BufferedWrite (f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
THEN
END
END WriteAny ;
PROCEDURE WriteChar (f: File; ch: CHAR) ;
BEGIN
CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite(f, SIZE(ch), ADR(ch))=SIZE(ch)
+ IF BufferedWrite(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
THEN
END
END WriteChar ;
j := pieceHead[p] ;
i := pieceHead[p-1]+1 ;
WHILE i<j DO
- IF pieceList[i]=t
+ IF pieceList[i] = VAL (CARDINAL8, t)
THEN
RETURN( TRUE )
END ;
p: CARDINAL ;
BEGIN
FOR p := 1 TO Pieces DO
- IF b.pieces[c][p]=from
+ IF b.pieces[c][p] = VAL (CARDINAL8, from)
THEN
RETURN p
END
RETURN FALSE
END ;
genMoves(b, m, col) ;
- IF from#b.pieces[col][peg]
+ IF VAL (CARDINAL8, from) # b.pieces[col][peg]
THEN
RETURN FALSE
END ;
i := m.pieceHead[peg-1]+1 ; (* skip the initial move *)
j := m.pieceHead[peg] ;
WHILE i<j DO
- IF to=m.pieceList[i]
+ IF VAL (CARDINAL8, to) = m.pieceList[i]
THEN
RETURN TRUE
END ;
projects / thirdparty / gcc.git / commitdiff
