FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ;
FROM StrLib IMPORT StrEqual ;
FROM M2Debug IMPORT Assert ;
-FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType, SkipType, IsProcedure, NoOfParam, IsVarParam, GetNth, GetNthParam, IsProcType, IsVar, IsEnumeration, IsArray, GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst, IsReallyPointer, IsPointer, IsParameter, ModeOfAddr, GetMode, GetType, IsUnbounded, IsComposite, IsConstructor, IsParameter, IsConstString ;
+
+FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
+ SkipType, IsProcedure, NoOfParam, IsVarParam, GetNth,
+ GetNthParam, IsProcType, IsVar, IsEnumeration, IsArray,
+ GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst,
+ IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
+ GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
+ IsParameter, IsConstString, IsConstLitInternal, IsConstLit ;
+
FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
FROM M2System IMPORT Address ;
FROM M2ALU IMPORT Equ, PushIntegerTree ;
END get ;
+(*
+ isInternal - return TRUE if sym is a constant lit which was declared
+ as internal.
+*)
+
+PROCEDURE isInternal (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsConstLit (sym) AND IsConstLitInternal (sym)
+END isInternal ;
+
+
(*
doCheck - keep obtaining an unresolved pair and check for the
type compatibility. This is the main check routine used by
printf ("doCheck (%d, %d)\n", left, right) ;
dumptInfo (tinfo)
END ;
+ IF isInternal (left) OR isInternal (right)
+ THEN
+ (* Do not check constants which have been generated internally.
+ Currently these are generated by the default BY constant value
+ in a FOR loop. *)
+ RETURN TRUE
+ END ;
(*
IF in (tinfo^.visited, left, right)
THEN
PutPriority, GetPriority,
PutProcedureBegin, PutProcedureEnd,
PutVarConst, IsVarConst,
+ PutConstLitInternal,
PutVarHeap,
IsVarParam, IsProcedure, IsPointer, IsParameter,
IsUnboundedParam, IsEnumeration, IsDefinitionForC,
|------------|
*)
-PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL; message: ARRAY OF CHAR) ;
+PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL;
+ message: ARRAY OF CHAR; internal: BOOLEAN) ;
+VAR
+ const: CARDINAL ;
BEGIN
IF type = NulSym
THEN
- PushTF (MakeConstLit (tok, MakeKey('1'), NulSym), NulSym)
+ const := MakeConstLit (tok, MakeKey('1'), NulSym) ;
+ PutConstLitInternal (const, TRUE) ;
+ PushTFtok (const, NulSym, tok)
ELSIF IsEnumeration (type)
THEN
IF NoOfElements (type) = 0
type) ;
PushZero (tok, type)
ELSE
- PushTF (Convert, NulSym) ;
+ PushTFtok (Convert, NulSym, tok) ;
PushT (type) ;
- PushT (MakeConstLit (tok, MakeKey ('1'), ZType)) ;
+ PushTFtok (MakeConstLit (tok, MakeKey ('1'), ZType), ZType, tok) ;
PushT (2) ; (* Two parameters *)
BuildConvertFunction
END
ELSE
- PushTF (MakeConstLit (tok, MakeKey ('1'), type), type)
+ const := MakeConstLit (tok, MakeKey ('1'), type) ;
+ PutConstLitInternal (const, TRUE) ;
+ PushTFtok (const, type, tok)
END
END PushOne ;
THEN
type := ZType
END ;
- PushOne (dotok, type, 'the implied {%kFOR} loop increment will cause an overflow {%1ad}')
+ PushOne (dotok, type,
+ 'the implied {%kFOR} loop increment will cause an overflow {%1ad}', TRUE)
END BuildPseudoBy ;
Ptr ->
+----------------+
+ | RangeId |
+ |----------------|
| ForQuad |
|----------------|
| LastValue |
THEN
OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
ELSE
- PushOne (proctok, dtype, 'the {%EkINC} will cause an overflow {%1ad}') ;
+ PushOne (proctok, dtype,
+ 'the {%EkINC} will cause an overflow {%1ad}', FALSE) ;
PopT (OperandSym)
END ;
THEN
OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
ELSE
- PushOne (proctok, dtype, 'the {%EkDEC} will cause an overflow {%1ad}') ;
+ PushOne (proctok, dtype,
+ 'the {%EkDEC} will cause an overflow {%1ad}', FALSE) ;
PopT (OperandSym)
END ;
des, expr2) ;
success := FALSE
END ;
-(*
combinedtok := MakeVirtual2Tok (destok, byconsttok) ;
IF NOT ExpressionTypeCompatible (combinedtok, "", des, byconst, TRUE, FALSE)
THEN
MetaErrorT2 (combinedtok,
- 'type expression incompatibility between {%1Et} and {%2t} detected between the the designator {%1a} and the {%kBY} constant expression {%2a} in the {%kFOR} loop',
+ 'type expression incompatibility between {%1Et} and {%2t} detected between the designator {%1a} and the {%kBY} constant expression {%2a} in the {%kFOR} loop',
des, byconst) ;
success := FALSE
END ;
-*)
IF (NOT success) AND (incrementquad # 0)
THEN
(* Avoid a subsequent generic type check error. *)
PROCEDURE IsProcedureBuiltinAvailable (procedure: CARDINAL) : BOOLEAN ;
+(*
+ PutConstLitInternal - marks the sym as being an internal constant.
+ Currently this is used when generating a default
+ BY constant expression during a FOR loop.
+ A constant marked as internal will always pass
+ an expression type check.
+*)
+
+PROCEDURE PutConstLitInternal (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsConstLitInternal - returns the value of the IsInternal field within
+ a constant expression.
+*)
+
+PROCEDURE IsConstLitInternal (sym: CARDINAL) : BOOLEAN ;
+
+
END SymbolTable.
Value : PtrToValue ; (* Value of the constant. *)
Type : CARDINAL ; (* TYPE of constant, char etc *)
IsSet : BOOLEAN ; (* is the constant a set? *)
- IsConstructor: BOOLEAN ; (* is the constant a set? *)
+ IsConstructor: BOOLEAN ; (* is it a constructor? *)
+ IsInternal : BOOLEAN ; (* Generated internally? *)
FromType : CARDINAL ; (* type is determined FromType *)
RangeError : BOOLEAN ; (* Have we reported an error? *)
UnresFromType: BOOLEAN ; (* is Type unresolved? *)
PopInto (ConstLit.Value) ;
ConstLit.Type := constType ;
ConstLit.IsSet := FALSE ;
+ ConstLit.IsInternal := FALSE ; (* Is it a default BY constant
+ expression? *)
ConstLit.IsConstructor := FALSE ;
ConstLit.FromType := NulSym ; (* type is determined FromType *)
ConstLit.RangeError := overflow ;
END PutConst ;
+(*
+ PutConstLitInternal - marks the sym as being an internal constant.
+ Currently this is used when generating a default
+ BY constant expression during a FOR loop.
+ A constant marked as internal will always pass
+ an expression type check.
+*)
+
+PROCEDURE PutConstLitInternal (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ConstLitSym: ConstLit.IsInternal := value
+
+ ELSE
+ InternalError ('expecting ConstLitSym')
+ END
+ END
+END PutConstLitInternal ;
+
+
+(*
+ IsConstLitInternal - returns the value of the IsInternal field within
+ a constant expression.
+*)
+
+PROCEDURE IsConstLitInternal (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ConstLitSym: RETURN ConstLit.IsInternal
+
+ ELSE
+ InternalError ('expecting ConstLitSym')
+ END
+ END
+END IsConstLitInternal ;
+
+
(*
PutVarArrayRef - assigns ArrayRef field with value.
*)
--- /dev/null
+MODULE forloopby ;
+
+
+PROCEDURE init ;
+CONST
+ increment = CARDINAL (1) ;
+VAR
+ i: INTEGER ;
+BEGIN
+ FOR i := 0 TO 10 BY increment DO
+ END
+END init ;
+
+
+BEGIN
+ init
+END forloopby.
--- /dev/null
+MODULE forloopby2 ;
+
+TYPE
+ negative = [-10..-1] ;
+
+
+PROCEDURE init ;
+VAR
+ i: negative ;
+BEGIN
+ FOR i := MIN (negative) TO MAX (negative) DO
+ END
+END init ;
+
+
+BEGIN
+ init
+END forloopby2.
projects / thirdparty / gcc.git / commitdiff
