ElementsSolved - returns TRUE if all ranges in the set have been solved.
*)
-PROCEDURE ElementsSolved (r: listOfRange) : BOOLEAN ;
+PROCEDURE ElementsSolved (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
BEGIN
WHILE r#NIL DO
WITH r^ DO
+ IF NOT IsConst (low)
+ THEN
+ MetaErrorT1 (tokenno, 'a constant set can only contain constant set elements, {%1Ead} is not a constant',
+ low)
+ END ;
+ IF (high # low) AND (NOT IsConst (high))
+ THEN
+ MetaErrorT1 (tokenno, 'a constant set can only contain constant set elements, {%1Ead} is not a constant',
+ high)
+ END ;
IF NOT (IsSolvedGCC(low) AND IsSolvedGCC(high))
THEN
RETURN( FALSE )
PROCEDURE EvalSetValues (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
BEGIN
- IF ElementsSolved(r)
+ IF ElementsSolved (tokenno, r)
THEN
SortElements(tokenno, r) ;
CombineElements(tokenno, r) ;
Tracing = FALSE ;
Debugging = FALSE ;
DebugRecover = FALSE ;
+ BadTokenNo = 32579 ;
InitialSourceToken = 2 ; (* 0 is unknown, 1 is builtin. *)
TYPE
to OpenSource. *)
+PROCEDURE stop ;
+END stop ;
+
+
(*
InitTokenDesc - returns a TokenDesc filled in with the parameters and
the insert field set to NIL.
AddTokToList (virtualrangetok, NulName, 0,
descLeft^.line, descLeft^.col, descLeft^.file,
GetLocationBinary (lc, ll, lr)) ;
- RETURN HighIndice (ListOfTokens)
+ caret := HighIndice (ListOfTokens)
END
END
END ;
+ IF caret = BadTokenNo
+ THEN
+ stop
+ END ;
RETURN caret
END MakeVirtualTok ;
PROCEDURE MakeVirtual2Tok (left, right: CARDINAL) : CARDINAL ;
BEGIN
- RETURN MakeVirtualTok (left, left, right)
+ RETURN MakeVirtualTok (left, left, right) ;
END MakeVirtual2Tok ;
Empty +------------+
| NulSym |
|------------|
+ tokpos is the position of the RETURN token.
*)
-PROCEDURE BuildNulExpression ;
+PROCEDURE BuildNulExpression (tokpos: CARDINAL) ;
(*
|--------------|
*)
-PROCEDURE BuildSetStart ;
+PROCEDURE BuildSetStart (tokpos: CARDINAL) ;
(*
| SetType | | SetType |
|-----------| |-------------|
+ tokpos points to the opening '{'.
*)
-PROCEDURE BuildEmptySet ;
+PROCEDURE BuildEmptySet (tokpos: CARDINAL) ;
(*
+------------+ +------------+
| const | | const |
|------------+ |------------|
+
+ startpos is the start of the constructor, either the typename or '{'
+ cbratokpos is the '}'.
*)
-PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
(*
it Pushes a Bitset type.
*)
-PROCEDURE BuildTypeForConstructor ;
+PROCEDURE BuildTypeForConstructor (tokpos: CARDINAL) ;
(*
CompilingProgramModule ;
FROM M2LexBuf IMPORT currenttoken, UnknownTokenNo, BuiltinTokenNo,
- GetToken, MakeVirtualTok,
+ GetToken, MakeVirtualTok, MakeVirtual2Tok,
GetFileName, TokenToLineNo, GetTokenName,
GetTokenNo, GetLineNo, GetPreviousTokenLineNo, PrintTokenNo ;
THEN
(* Tell code generator to test runtime values of assignment so ensure we
catch overflow and underflow. *)
- BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp))
+ BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp, destok, exptok))
END ;
IF checkTypes
THEN
Empty +------------+
| NulSym |
|------------|
+ tokpos is the position of the RETURN token.
*)
-PROCEDURE BuildNulExpression ;
+PROCEDURE BuildNulExpression (tokpos: CARDINAL) ;
BEGIN
- PushT(NulSym)
+ PushTtok (NulSym, tokpos)
END BuildNulExpression ;
it Pushes a Bitset type.
*)
-PROCEDURE BuildTypeForConstructor ;
+PROCEDURE BuildTypeForConstructor (tokpos: CARDINAL) ;
VAR
c: ConstructorFrame ;
BEGIN
IF NoOfItemsInStackAddress(ConstructorStack)=0
THEN
- PushT(Bitset)
+ PushTtok (Bitset, tokpos)
ELSE
c := PeepAddress(ConstructorStack, 1) ;
WITH c^ DO
- IF IsArray(type) OR IsSet(type)
+ IF IsArray (type) OR IsSet (type)
THEN
- PushT(GetSType(type))
- ELSIF IsRecord(type)
+ PushTtok (GetSType (type), tokpos)
+ ELSIF IsRecord (type)
THEN
- PushT(GetSType(GetNth(type, index)))
+ PushTtok (GetSType (GetNth (type, index)), tokpos)
ELSE
- MetaError1('{%1ad} is not a set, record or array type which is expected when constructing an aggregate entity',
- type)
+ MetaError1 ('{%1ad} is not a set, record or array type which is expected when constructing an aggregate entity',
+ type)
END
END
END
|--------------|
*)
-PROCEDURE BuildSetStart ;
+PROCEDURE BuildSetStart (tokpos: CARDINAL) ;
BEGIN
- PushT(Bitset)
+ PushTtok (Bitset, tokpos)
END BuildSetStart ;
PROCEDURE BuildSetEnd ;
VAR
- v, t: CARDINAL ;
+ valuepos, typepos,
+ combined,
+ value, type : CARDINAL ;
BEGIN
- PopT(v) ;
- PopT(t) ;
- PushTF(v, t) ;
- Assert(IsSet(t))
+ PopTtok (value, valuepos) ;
+ PopTtok (type, typepos) ;
+ combined := MakeVirtual2Tok (typepos, valuepos) ;
+ PushTFtok (value, type, combined) ;
+ Assert (IsSet (type))
END BuildSetEnd ;
| SetType | | SetType |
|-----------| |-------------|
+ tokpos points to the opening '{'.
*)
-PROCEDURE BuildEmptySet ;
+PROCEDURE BuildEmptySet (tokpos: CARDINAL) ;
VAR
- n : Name ;
- Type : CARDINAL ;
- NulSet: CARDINAL ;
- tok : CARDINAL ;
+ n : Name ;
+ typepos,
+ Type : CARDINAL ;
+ NulSet : CARDINAL ;
+ tok : CARDINAL ;
BEGIN
- PopT(Type) ; (* type of set we are building *)
- tok := GetTokenNo () ;
- IF (Type=NulSym) AND Pim
+ PopTtok (Type, typepos) ; (* type of set we are building *)
+ IF (Type = NulSym) AND Pim
THEN
(* allowed generic {} in PIM Modula-2 *)
- ELSIF IsUnknown(Type)
+ typepos := tokpos
+ ELSIF IsUnknown (Type)
THEN
- n := GetSymName(Type) ;
- WriteFormat1('set type %a is undefined', n) ;
+ n := GetSymName (Type) ;
+ WriteFormat1 ('set type %a is undefined', n) ;
Type := Bitset
- ELSIF NOT IsSet(SkipType(Type))
+ ELSIF NOT IsSet (SkipType (Type))
THEN
- n := GetSymName(Type) ;
+ n := GetSymName (Type) ;
WriteFormat1('expecting a set type %a', n) ;
Type := Bitset
ELSE
- Type := SkipType(Type) ;
- Assert((Type#NulSym))
+ Type := SkipType (Type) ;
+ Assert (Type # NulSym)
END ;
- NulSet := MakeTemporary(tok, ImmediateValue) ;
- PutVar(NulSet, Type) ;
- PutConstSet(NulSet) ;
+ NulSet := MakeTemporary (typepos, ImmediateValue) ;
+ PutVar (NulSet, Type) ;
+ PutConstSet (NulSet) ;
IF CompilerDebugging
THEN
- n := GetSymName(Type) ;
- printf1('set type = %a\n', n)
+ n := GetSymName (Type) ;
+ printf1 ('set type = %a\n', n)
END ;
- PushNulSet(Type) ; (* onto the ALU stack *)
- PopValue(NulSet) ; (* ALU -> symbol table *)
+ PushNulSet (Type) ; (* onto the ALU stack *)
+ PopValue (NulSet) ; (* ALU -> symbol table *)
(* and now construct the M2Quads stack as defined by the comments above *)
- PushT(Type) ;
- PushT(NulSet) ;
+ PushTtok (Type, typepos) ;
+ PushTtok (NulSet, typepos) ;
IF CompilerDebugging
THEN
- n := GetSymName(Type) ;
- printf2('Type = %a (%d) built empty set\n', n, Type) ;
+ n := GetSymName (Type) ;
+ printf2 ('Type = %a (%d) built empty set\n', n, Type) ;
DisplayStack (* Debugging info *)
END
END BuildEmptySet ;
PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
VAR
+ typepos,
constValue,
type : CARDINAL ;
BEGIN
- PopT (type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
+ PopTtok (type, typepos) ; (* we ignore the type as we already have the constructor symbol from pass C *)
GetConstructorFromFifoQueue (constValue) ;
IF type # GetSType (constValue)
THEN
+------------+ +------------+
| const | | const |
|------------| |------------|
+
+ startpos is the start of the constructor, either the typename or '{'
+ cbratokpos is the '}'.
*)
-PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
VAR
typetok,
value, valtok: CARDINAL ;
BEGIN
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString ('startpos'), startpos) ;
+ WarnStringAt (InitString ('cbratokpos'), cbratokpos)
+ END ;
PopTtok (value, valtok) ;
- IF IsBoolean (1)
+ IF DebugTokPos
THEN
- typetok := valtok
- ELSE
- typetok := OperandTtok (1)
+ WarnStringAt (InitString ('value valtok'), valtok)
END ;
- valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ;
+ valtok := MakeVirtual2Tok (startpos, cbratokpos) ;
PutDeclared (valtok, value) ;
PushTtok (value, valtok) ; (* Use valtok as we now know it was a constructor. *)
- PopConstructor
- (* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *)
+ PopConstructor ;
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString ('aggregate constant'), valtok)
+ END
END BuildConstructorEnd ;
can be generated later on.
*)
-PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL;
+ des, expr: CARDINAL;
+ destok, exprtok: CARDINAL) : CARDINAL ;
(*
(*
InitAssignmentRangeCheck - returns a range check node which
remembers the information necessary
- so that a range check for d := e
+ so that a range check for des := expr
can be generated later on.
*)
-PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL;
+ des, expr: CARDINAL;
+ destok, exprtok: CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
+ p: Range ;
BEGIN
r := InitRange () ;
- Assert (PutRange (tokno, GetIndice (RangeIndex, r), assignment, d, e) # NIL) ;
+ p := GetIndice (RangeIndex, r) ;
+ Assert (PutRange (tokno, p, assignment, des, expr) # NIL) ;
+ p^.destok := destok ;
+ p^.exprtok := exprtok ;
RETURN r
END InitAssignmentRangeCheck ;
BEGIN
p := GetIndice (RangeIndex, r) ;
WITH p^ DO
- TryDeclareConstant (tokenNo, expr) ;
+ TryDeclareConstant (exprtok, expr) ;
IF desLowestType # NulSym
THEN
IF AssignmentTypeCompatible (tokenno, "", des, expr)
)
=:
-ComponentValue := ComponentElement ( 'BY' ConstExpression % PushTtok(ByTok, GetTokenNo() -1) %
+ComponentValue := % VAR tokpos: CARDINAL ; %
+ (
+ % tokpos := GetTokenNo () %
+ ComponentElement ( % tokpos := GetTokenNo () %
+ 'BY' ConstExpression % PushTtok (ByTok, tokpos) %
- | % PushT(NulTok) %
- )
+ | % PushTtok (NulTok, tokpos) %
+ )
+ )
=:
ArraySetRecordValue := ComponentValue % BuildComponentValue %
}
=:
-Constructor := % DisplayStack %
- '{' % BuildConstructorStart (GetTokenNo() -1) %
- [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
+Constructor := % VAR tokpos: CARDINAL ; %
+ % DisplayStack %
+ '{' % tokpos := GetTokenNo () -1 %
+ % BuildConstructorStart (tokpos) %
+ [ ArraySetRecordValue ] % BuildConstructorEnd (tokpos, GetTokenNo()) %
'}' =:
-ConstSetOrQualidentOrFunction := Qualident
- [ Constructor | ConstActualParameters % BuildConstFunctionCall %
- ]
- | % BuildTypeForConstructor %
- Constructor =:
+ConstSetOrQualidentOrFunction := % VAR tokpos: CARDINAL ; %
+ % tokpos := GetTokenNo () %
+ (
+ Qualident
+ [ Constructor | ConstActualParameters % BuildConstFunctionCall %
+ ]
+ | % BuildTypeForConstructor (tokpos) %
+ Constructor
+ ) =:
ConstActualParameters := % PushInConstExpression %
ActualParameters % PopInConstExpression %
| ConstAttribute
) =:
-SetOrDesignatorOrFunction := Qualident
- % Assert (OperandTok(1) # UnknownTokenNo) %
+SetOrDesignatorOrFunction := % VAR tokpos: CARDINAL ; %
+ % tokpos := GetTokenNo () %
+ (
+ Qualident
+ % Assert (OperandTok (1) # UnknownTokenNo) %
% CheckWithReference %
- % Assert (OperandTok(1) # UnknownTokenNo) %
+ % Assert (OperandTok (1) # UnknownTokenNo) %
[ Constructor |
SimpleDes % (* Assert (OperandTok(1) # UnknownTokenNo) *) %
[ ActualParameters % IF IsInConstExpression()
END %
]
] |
- % BuildTypeForConstructor %
- Constructor =:
+ % BuildTypeForConstructor (tokpos) %
+ Constructor ) =:
-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
SimpleDes := { SubDesignator } =:
ReturnStatement := "RETURN" % VAR tokno: CARDINAL ; %
% tokno := GetTokenNo () -1 %
- ( Expression | % BuildNulExpression (* in epsilon *) %
+ ( Expression | % BuildNulExpression (tokno) %
) % BuildReturn (tokno) %
=:
-- the entry to Constructor
ConstSetOrQualidentOrFunction := % PushAutoOff %
- (
+ % VAR tokpos: CARDINAL ; %
+ ( % tokpos := GetTokenNo () %
PushQualident
( ConstructorOrConstActualParameters | % PushConstType %
% PopNothing %
)
- | % BuildTypeForConstructor %
+ | % BuildTypeForConstructor (tokpos) %
Constructor ) % PopAuto %
=:
=:
SetOrDesignatorOrFunction := % PushAutoOff %
- (
+ % VAR tokpos: CARDINAL ; %
+
+ ( % tokpos := GetTokenNo () %
PushQualident
( ConstructorOrSimpleDes | % PopNothing %
)
|
- % BuildTypeForConstructor %
+ % BuildTypeForConstructor (tokpos) %
Constructor
) % PopAuto %
=:
}
=:
-Constructor := '{' % BuildConstructorStart (GetTokenNo() -1) %
- [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
+Constructor := % VAR tokpos: CARDINAL ; %
+ % DisplayStack %
+ '{' % tokpos := GetTokenNo () -1 %
+ % BuildConstructorStart (tokpos) %
+ [ ArraySetRecordValue ] % BuildConstructorEnd (tokpos, GetTokenNo()) %
'}' =:
-ConstSetOrQualidentOrFunction := % PushAutoOn %
- (
+ConstSetOrQualidentOrFunction := % PushAutoOn %
+ % VAR tokpos: CARDINAL ; %
+ ( % tokpos := GetTokenNo () %
Qualident
[ Constructor |
ConstActualParameters % BuildConstFunctionCall %
]
- | % BuildTypeForConstructor %
+ | % BuildTypeForConstructor (tokpos) %
Constructor
- ) % PopAuto %
+ ) % PopAuto %
=:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
--- /dev/null
+MODULE badtype2 ;
+
+VAR
+ x: CARDINAL ;
+ ch: CHAR ;
+BEGIN
+ x := 6 ;
+ ch := {7 .. x};
+END badtype2.
git://gcc.gnu.org / gcc.git / commitdiff