THEN
missing := TRUE ;
MetaErrorT2 (tokenno,
- 'not all variant record alternatives in the CASE clause are specified, hint you either need to specify each value of {%2ad} or use an ELSE clause {%1U}',
+ 'not all variant record alternatives in the {%kCASE} clause are specified, hint you either need to specify each value of {%2ad} or use an {%kELSE} clause',
varient, type) ;
ErrorRanges(p, type, set)
END ;
qprintf0 ('\n') ;
CloseSource
ELSE
- MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUF%s} containing module {%%1a} cannot be found'), FileName), Sym) ;
- FlushWarnings ; FlushErrors ;
- fprintf1(StdErr, 'failed to open %s\n', FileName) ;
- exit(1)
+ (* Unrecoverable error. *)
+ MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
+ FileName), Sym)
END
ELSE
- MetaError1 ('the file containing the definition module {%1EUa} cannot be found', Sym) ;
- FlushWarnings ; FlushErrors ;
- fprintf1(StdErr, 'failed to find definition module %s.def\n', SymName) ;
- exit(1)
+ (* Unrecoverable error. *)
+ MetaError1 ('the file containing the definition module {%1EMAa} cannot be found', Sym)
END ;
ModuleType := Implementation
ELSE
is used. *)
IF (NOT WholeProgram) OR (Sym=Main) OR IsHiddenTypeDeclared(Sym)
THEN
- MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUF%s} containing module {%%1a} cannot be found'), FileName), Sym) ;
- FlushWarnings ; FlushErrors ;
- fprintf1(StdErr, 'file %s cannot be opened\n', FileName)
+ (* Unrecoverable error. *)
+ MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
+ FileName), Sym) ;
END
END
END
FROM NameKey IMPORT Name, KeyToCharStar, NulName ;
FROM StrLib IMPORT StrLen ;
FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ;
-FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors ;
+FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors, FlushWarnings ;
FROM FIO IMPORT StdOut, WriteLine ;
FROM SFIO IMPORT WriteS ;
FROM StringConvert IMPORT ctos ;
BEGIN
IF seenAbort
THEN
+ FlushWarnings ;
FlushErrors
END
END checkAbort ;
BuildRetry - adds an RetryOp quadruple.
*)
-PROCEDURE BuildRetry ;
+PROCEDURE BuildRetry (tok: CARDINAL) ;
(*
PushSize, PushValue, PopValue,
GetVariableAtAddress, IsVariableAtAddress,
MakeError, UnknownReported,
+ IsError,
IsInnerModule,
IsImportStatement, IsImport, GetImportModule, GetImportDeclared,
GetImportStatementList,
MetaErrorT2 (combinedtok,
'cannot assign a constant designator {%1Ead} with an expression {%2Ead}',
des, exp)
- END
+ END ;
+ PopN (2) (* Remove both parameters. *)
+ ELSIF IsError (des)
+ THEN
+ PopN (2) (* Remove both parameters. *)
ELSE
doBuildAssignment (becomesTokNo, TRUE, TRUE)
END
END BuildDesignatorRecord ;
+(*
+ BuildDesignatorError - removes the designator from the stack and replaces
+ it with an error symbol.
+*)
+
+PROCEDURE BuildDesignatorError (message: ARRAY OF CHAR) ;
+VAR
+ combinedTok,
+ arrayTok,
+ exprTok : CARDINAL ;
+ s : String ;
+ e, d, error,
+ Sym,
+ Type : CARDINAL ;
+BEGIN
+ PopTtok (e, exprTok) ;
+ PopTFDtok (Sym, Type, d, arrayTok) ;
+ combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
+ error := MakeError (combinedTok, MakeKey (message)) ;
+ PushTFDtok (error, Type, d, arrayTok)
+END BuildDesignatorError ;
+
+
+
(*
BuildDesignatorArray - Builds the array referencing.
The purpose of this procedure is to work out
PushTtok (e, exprTok)
END
END ;
- IF (NOT IsVar(OperandT(2))) AND (NOT IsTemporary(OperandT(2)))
+ IF (NOT IsVar (OperandT (2))) AND (NOT IsTemporary (OperandT (2)))
THEN
- ErrorStringAt2(Mark(InitString('can only access arrays using variables or formal parameters')),
- GetDeclaredMod(OperandT(2)), GetTokenNo())
+ MetaErrorT1 (OperandTtok (2),
+ 'can only access arrays using variables or formal parameters not {%1Ead}',
+ OperandT (2)) ;
+ BuildDesignatorError ('bad array access')
END ;
- Sym := GetDType(OperandT(2)) ;
- IF Sym=NulSym
+ Sym := OperandT (2) ;
+ Type := GetDType (Sym) ;
+ arrayTok := OperandTtok (2) ;
+ IF Type = NulSym
THEN
- IF GetSymName(Sym)=NulName
+ IF (arrayTok = UnknownTokenNo) OR (arrayTok = BuiltinTokenNo)
THEN
- ErrorStringAt(Mark(InitString('type of array is undefined (no such array declared)')), GetTokenNo())
- ELSE
- s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Sym)))) ;
- ErrorStringAt(Sprintf1(Mark(InitString('type of array is undefined (%s)')),
- s),
- GetTokenNo())
- END
- END ;
- IF IsUnbounded(Sym)
+ arrayTok := GetTokenNo ()
+ END ;
+ MetaErrorT0 (arrayTok, "type of array is undefined") ;
+ BuildDesignatorError ('bad array access')
+ ELSIF IsUnbounded (Type)
THEN
BuildDynamicArray
- ELSIF IsArray(Sym)
+ ELSIF IsArray (Type)
THEN
BuildStaticArray
ELSE
- MetaError0 ('{%E}can only index static or dynamic arrays')
+ MetaErrorT1 (arrayTok,
+ 'can only index static or dynamic arrays, {%1Ead} is not an array but a {%tad}',
+ Sym) ;
+ BuildDesignatorError ('bad array access')
END
END BuildDesignatorArray ;
THEN
n := NoOfItemsInStackAddress(WithStack) ;
i := 1 ; (* top of the stack *)
- WHILE i<=n DO
+ WHILE i <= n DO
(* Search for other declarations of the with using Type *)
f := PeepAddress(WithStack, i) ;
IF f^.RecordSym=Type
THEN
- WriteFormat0('cannot have nested WITH statements referencing the same RECORD')
+ MetaErrorT1 (Tok,
+ 'cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}',
+ Sym) ;
+ MetaErrorT1 (f^.RecordTokPos,
+ 'cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}',
+ f^.RecordSym)
END ;
- INC(i)
+ INC (i)
END
END ;
- NEW(f) ;
+ NEW (f) ;
WITH f^ DO
RecordSym := Sym ;
RecordType := Type ;
VAR
f: WithFrame ;
BEGIN
- f := PopAddress(WithStack) ;
- DISPOSE(f)
+ f := PopAddress (WithStack) ;
+ DISPOSE (f)
END PopWith ;
FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM M2Printf IMPORT printf0, printf1, printf2 ;
FROM Lists IMPORT List, InitList, KillList, IncludeItemIntoList, RemoveItemFromList, NoOfItemsInList, GetItemFromList, IsItemInList ;
+FROM Indexing IMPORT Index, InitIndex, HighIndice, LowIndice, GetIndice, RemoveIndiceFromIndex, IncludeIndiceIntoIndex ;
FROM M2Batch IMPORT MakeDefinitionSource, MakeProgramSource, MakeImplementationSource ;
FROM SymbolTable IMPORT NulSym, MakeInnerModule, SetCurrentModule, SetFileModule, MakeError, PutDefinitionForC ;
FROM NameKey IMPORT Name, NulName ;
-FROM M2Quads IMPORT PushT, PushTF, PopT, PopTF, PopN, OperandT, PopTtok, PushTtok ;
+FROM M2Quads IMPORT PushT, PushTF, PopT, PopTF, PopN, OperandT, PopTtok, PushTtok, OperandTok ;
FROM M2Reserved IMPORT ImportTok ;
FROM M2Debug IMPORT Assert ;
FROM M2MetaError IMPORT MetaErrorT1, MetaErrorT2, MetaError1, MetaError2 ;
sym : CARDINAL ;
level : CARDINAL ;
token : CARDINAL ; (* where the block starts. *)
- LocalModules, (* locally declared modules at the current level *)
- ImportedModules: List ; (* current list of imports for the scanned module *)
+ LocalModules : List ; (* locally declared modules at the current level *)
+ ImportedModules: Index ; (* current list of imports for the scanned module *)
toPC,
toReturn,
toNext, (* next in same level *)
toDown : BlockInfoPtr ; (* first of the inner level *)
END ;
+ ModuleDesc = POINTER TO RECORD
+ name: Name ; (* Name of the module. *)
+ tok : CARDINAL ; (* Location where the module ident was first seen. *)
+ END ;
+
VAR
headBP,
curBP : BlockInfoPtr ;
name := n ;
kind := k ;
sym := s ;
- InitList(LocalModules) ;
- InitList(ImportedModules) ;
+ InitList (LocalModules) ;
+ ImportedModules := InitIndex (1) ;
toPC := NIL ;
toReturn := NIL ;
toNext := NIL ;
name := NulName ;
kind := universe ;
sym := NulSym ;
- InitList(LocalModules) ;
- InitList(ImportedModules) ;
+ InitList (LocalModules) ;
+ ImportedModules := InitIndex (1) ;
toNext := NIL ;
toDown := NIL ;
toUp := curBP ;
VAR
i, n : CARDINAL ;
modname: Name ;
+ desc : ModuleDesc ;
BEGIN
WITH b^ DO
- i := 1 ;
- n := NoOfItemsInList (ImportedModules) ;
- WHILE i<=n DO
- modname := GetItemFromList (ImportedModules, i) ;
- sym := MakeDefinitionSource (GetTokenNo (), modname) ;
+ i := LowIndice (ImportedModules) ;
+ n := HighIndice (ImportedModules) ;
+ WHILE i <= n DO
+ desc := GetIndice (ImportedModules, i) ;
+ sym := MakeDefinitionSource (desc^.tok, desc^.name) ;
Assert (sym # NulSym) ;
INC (i)
END
RegisterLocalModule - register, n, as a local module.
*)
-PROCEDURE RegisterLocalModule (n: Name) ;
+PROCEDURE RegisterLocalModule (name: Name) ;
+VAR
+ i, n: CARDINAL ;
+ desc: ModuleDesc ;
BEGIN
(* printf1('seen local module %a\n', n) ; *)
WITH curBP^ DO
- IncludeItemIntoList(LocalModules, n) ;
- RemoveItemFromList(ImportedModules, n)
+ IncludeItemIntoList (LocalModules, n) ;
+ i := LowIndice (ImportedModules) ;
+ n := HighIndice (ImportedModules) ;
+ WHILE i <= n DO
+ desc := GetIndice (ImportedModules, i) ;
+ IF desc^.name = name
+ THEN
+ RemoveIndiceFromIndex (ImportedModules, desc) ;
+ DISPOSE (desc) ;
+ RETURN (* All done. *)
+ ELSE
+ INC (i)
+ END
+ END
END
END RegisterLocalModule ;
RegisterImport - register, n, as a module imported from either a local scope or definition module.
*)
-PROCEDURE RegisterImport (n: Name) ;
+PROCEDURE RegisterImport (n: Name; tok: CARDINAL) ;
VAR
- bp: BlockInfoPtr ;
+ bp : BlockInfoPtr ;
+ desc: ModuleDesc ;
BEGIN
(* printf1('register import from module %a\n', n) ; *)
Assert(curBP#NIL) ;
Assert(curBP^.toUp#NIL) ;
bp := curBP^.toUp ; (* skip over current module *)
WITH bp^ DO
- IF NOT IsItemInList(LocalModules, n)
+ IF NOT IsItemInList (LocalModules, n)
THEN
- IncludeItemIntoList(ImportedModules, n)
+ NEW (desc) ;
+ desc^.name := n ;
+ desc^.tok := tok ;
+ IncludeIndiceIntoIndex (ImportedModules, desc)
END
END
END RegisterImport ;
PROCEDURE RegisterImports ;
VAR
- i, n: CARDINAL ;
+ index,
+ i, n : CARDINAL ;
BEGIN
PopT(n) ; (* n = # of the Ident List *)
IF OperandT(n+1)=ImportTok
(* Ident list contains Module Names *)
i := 1 ;
WHILE i<=n DO
- RegisterImport(OperandT(n+1-i)) ;
+ index := n+1-i ;
+ RegisterImport (OperandT (index), OperandTok (index)) ;
INC(i)
END
ELSE
(* Ident List contains list of objects *)
- RegisterImport(OperandT(n+1))
+ RegisterImport (OperandT (n+1), OperandTok (n+1))
END ;
PopN(n+1) (* clear stack *)
END RegisterImports ;
*)
ELSE
(* Ident List contains list of objects, but we are importing directly from a module OperandT(n+1) *)
- RegisterImport(OperandT(n+1))
+ RegisterImport (OperandT (n+1), OperandTok (n+1))
END ;
- PopN(n+1) (* clear stack *)
+ PopN (n+1) (* clear stack *)
END RegisterInnerImports ;
InsertTokenAndRewind, GetTokenNo, DisplayToken, DumpTokens ;
FROM M2MetaError IMPORT MetaErrorStringT0 ;
-FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack, PushTFtok ;
+FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack, PushTFtok, PushTtok ;
FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM NameKey IMPORT Name, NulName, makekey ;
) ";" =:
Import := "FROM" Ident "IMPORT" IdentList ";" |
- "IMPORT" % PushT(ImportTok)
+ "IMPORT" % PushTtok (ImportTok, GetTokenNo () -1)
(* determines whether Ident or Module *) %
IdentList ";" =:
] % PopAuto ; %
=:
-RetryStatement := "RETRY" % BuildRetry %
+RetryStatement := "RETRY" % BuildRetry (GetTokenNo () -1) %
=:
AssignmentOrProcedureCall := % VAR isFunc: BOOLEAN ;
tok: CARDINAL ; %
"WITH" % tok := GetTokenNo () -1 %
Designator % StartBuildWith (tok) %
+ % BuildStmtNote (0) %
"DO"
StatementSequence
% BuildStmtNote (0) %
Sym : CARDINAL ;
BEGIN
(* if Sym is present on the unknown tree then remove it *)
- Sym := FetchUnknownSym(name) ;
+ Sym := FetchUnknownSym (name) ;
IF Sym=NulSym
THEN
NewSym(Sym)
projects / thirdparty / gcc.git / commitdiff
