From 8410402272038aae7e4b2bd76df38607a78cad95 Mon Sep 17 00:00:00 2001 From: Gaius Mulley Date: Mon, 11 Mar 2024 15:21:42 +0000 Subject: [PATCH] PR modula2/114295 Incorrect location if compiling implementation without definition This patch fixes a bug which occurred if gm2 was asked to compile an implementation module and could not find the definition module. The error location would be set to the SYSTEM module. The bug occurred as the module sym was created during the peep phase after which the few tokens are destroyed and recreated during parsing. The bug fix is to call PutDeclared when the module is encountered during parsing which updates the tokenno associated with the module. gcc/m2/ChangeLog: PR modula2/114295 * gm2-compiler/M2Batch.mod (MakeProgramSource): Call PutDeclared if the module is known. (MakeDefinitionSource): Ditto. (MakeImplementationSource): Ditto. * gm2-compiler/M2Comp.mod (ExamineHeader): New procedure. (ExamineCompilationUnit): Rewrite. (PeepInto): Rewrite. * gm2-compiler/M2Error.mod (NewError): Remove default call to GetTokenNo. * gm2-compiler/M2Quads.mod (callRequestDependant): Push tokno with Adr. (BuildStringAdrParam): Ditto. (doBuildBinaryOp): Push OperatorPos on the bool stack. (BuildRelOp): Ditto. * gm2-compiler/P2Build.bnf (SetType): Pass set token pos to BuildSetType. (PointerType): Pass pointer token pos to BuildPointerType. * gm2-compiler/P2SymBuild.def (BuildPointerType): Add parameter pointerpos. (BuildSetType): Add parameter setpos. * gm2-compiler/P2SymBuild.mod (BuildPointerType): Add parameter pointerpos. Build combined token and use it when creating a pointer type. (BuildSetType): Add parameter setpos. Build combined token and use it when creating a set type. * gm2-compiler/SymbolTable.mod (DebugUnknownToken): New constant. (CheckTok): New procedure function. (MakeProcedure): Call CheckTok. (MakeRecord): Ditto. (MakeVarient): Ditto. (MakeEnumeration): Ditto. (MakeHiddenType): Ditto. (MakeConstant): Ditto. (MakeConstStringCnul): Ditto. (MakeSubrange): Ditto. (MakeTemporary): Ditto. (MakeVariableForParam): Ditto. (MakeParameterHeapVar): Ditto. (MakePointer): Ditto. (MakeSet): Ditto. (MakeUnbounded): Ditto. (MakeProcType): Ditto. Signed-off-by: Gaius Mulley --- gcc/m2/gm2-compiler/M2Batch.mod | 12 +++- gcc/m2/gm2-compiler/M2Comp.mod | 88 +++++++++++++++++++++-------- gcc/m2/gm2-compiler/M2Error.mod | 6 +- gcc/m2/gm2-compiler/M2Quads.mod | 42 +++++++------- gcc/m2/gm2-compiler/P2Build.bnf | 13 +++-- gcc/m2/gm2-compiler/P2SymBuild.def | 4 +- gcc/m2/gm2-compiler/P2SymBuild.mod | 45 ++++++++------- gcc/m2/gm2-compiler/SymbolTable.mod | 47 ++++++++++++++- 8 files changed, 179 insertions(+), 78 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2Batch.mod b/gcc/m2/gm2-compiler/M2Batch.mod index d6eb53ff90db..8cfc906513cc 100644 --- a/gcc/m2/gm2-compiler/M2Batch.mod +++ b/gcc/m2/gm2-compiler/M2Batch.mod @@ -23,7 +23,11 @@ IMPLEMENTATION MODULE M2Batch ; FROM M2Debug IMPORT Assert ; -FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp, GetScope, GetLocalSym, GetCurrentScope, GetSym, NulSym ; + +FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp, + GetScope, GetLocalSym, GetCurrentScope, + PutDeclared, GetSym, NulSym ; + FROM NameKey IMPORT GetKey, WriteKey ; FROM M2Printf IMPORT printf2 ; FROM M2Error IMPORT InternalError ; @@ -69,6 +73,8 @@ BEGIN Sym := MakeModule (tok, n) ; Put (Sym, n) ; Push (Sym) + ELSE + PutDeclared (tok, Sym) END ; RETURN Sym END MakeProgramSource ; @@ -96,6 +102,8 @@ BEGIN Sym := MakeDefImp (tok, n) ; Put (Sym, n) ; Push (Sym) + ELSE + PutDeclared (tok, Sym) END ; RETURN Sym END MakeDefinitionSource ; @@ -123,6 +131,8 @@ BEGIN Sym := MakeDefImp (tok, n) ; Put (Sym, n) ; Push (Sym) + ELSE + PutDeclared (tok, Sym) END ; RETURN Sym END MakeImplementationSource ; diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod index c10c301cbde3..719ae6641dc6 100644 --- a/gcc/m2/gm2-compiler/M2Comp.mod +++ b/gcc/m2/gm2-compiler/M2Comp.mod @@ -30,7 +30,8 @@ FROM M2Search IMPORT FindSourceDefFile, FindSourceModFile ; FROM M2Code IMPORT Code ; FROM M2LexBuf IMPORT OpenSource, CloseSource, ResetForNewPass, currenttoken, GetToken, - ReInitialize, currentstring, GetTokenNo ; + ReInitialize, currentstring, GetTokenNo, BuiltinTokenNo, + UnknownTokenNo ; FROM M2FileName IMPORT CalculateFileName ; FROM M2Preprocess IMPORT PreprocessModule, MakeSaveTempsFileNameExt, OnExitDelete ; @@ -288,32 +289,74 @@ BEGIN END compile ; +(* + ExamineHeader - examines up until the ';', '[' or eof and determines if the source file + is a program, implementation/definition module. +*) + +PROCEDURE ExamineHeader (VAR name: ADDRESS; VAR isdefimp, module: BOOLEAN) ; +BEGIN + (* Stop if we see one of eof ';' '['. *) + WHILE (currenttoken#eoftok) AND + (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO + IF name = NIL + THEN + IF (currenttoken=implementationtok) OR (currenttoken=definitiontok) + THEN + isdefimp := TRUE ; + GetToken + END ; + IF currenttoken=moduletok + THEN + module := TRUE ; + GetToken ; + IF currenttoken=identtok + THEN + name := currentstring + END + END ; + END ; + GetToken + END ; +END ExamineHeader ; + + (* ExamineCompilationUnit - opens the source file to obtain the module name and kind of module. *) -PROCEDURE ExamineCompilationUnit (VAR name: ADDRESS; VAR isdefimp: BOOLEAN) ; +PROCEDURE ExamineCompilationUnit () : CARDINAL ; VAR - Message: String ; + Message : String ; + name : ADDRESS ; + module, + isdefimp: BOOLEAN ; BEGIN + name := NIL ; isdefimp := FALSE ; (* default to program module *) - (* stop if we see eof, ';' or '[' *) - WHILE (currenttoken#eoftok) AND (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO - IF (currenttoken=implementationtok) OR (currenttoken=definitiontok) + module := FALSE ; (* Seen module keyword? *) + ExamineHeader (name, isdefimp, module) ; + IF name = NIL + THEN + IF module THEN - isdefimp := TRUE ; - GetToken + Message := MetaString0 (InitString ('no {%kMODULE} keyword seen')) + ELSE + Message := MetaString0 (InitString ('no module ident seen')) END ; - IF currenttoken=identtok + m2flex.M2Error (string (Message)) ; + exit (1) + ELSE + (* The token used is will be overwritten when P0 is underway. + At this point we are determining the module kind and the tokens + read will be discarded (see ReInitialize below). *) + IF isdefimp THEN - name := currentstring ; - RETURN - END ; - GetToken - END ; - Message := MetaString0 (InitString ('no {%kMODULE} name found')) ; - m2flex.M2Error (string (Message)) ; - exit (1) + RETURN MakeImplementationSource (BuiltinTokenNo, makekey (name)) + ELSE + RETURN MakeProgramSource (BuiltinTokenNo, makekey (name)) + END + END END ExamineCompilationUnit ; @@ -324,17 +367,14 @@ END ExamineCompilationUnit ; PROCEDURE PeepInto (s: String) ; VAR - name : ADDRESS ; - isdefimp: BOOLEAN ; + mainModule: CARDINAL ; BEGIN IF OpenSource (s) THEN - ExamineCompilationUnit (name, isdefimp) ; - IF isdefimp + mainModule := ExamineCompilationUnit () ; + IF mainModule # NulSym THEN - SetMainModule (MakeImplementationSource (GetTokenNo (), makekey (name))) - ELSE - SetMainModule (MakeProgramSource (GetTokenNo (), makekey (name))) + SetMainModule (mainModule) END ; CloseSource ; ReInitialize diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod index 37e08248eea8..1d79c804a597 100644 --- a/gcc/m2/gm2-compiler/M2Error.mod +++ b/gcc/m2/gm2-compiler/M2Error.mod @@ -398,10 +398,8 @@ VAR BEGIN IF AtTokenNo = UnknownTokenNo THEN - (* this could be used as a useful debugging hook as the front end - has forgotten the token no. This can occur if a complex record - structure or array is used for example. *) - AtTokenNo := GetTokenNo () + (* This could be used as a useful debugging hook as the front end + has forgotten the token no. *) END ; NEW(e) ; WITH e^ DO diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 2be229d0bf82..3231f9f56067 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -2384,12 +2384,12 @@ PROCEDURE callRequestDependant (tokno: CARDINAL; BEGIN Assert (requestDep # NulSym) ; PushTtok (requestDep, tokno) ; - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tokno) ; PushTtok (MakeConstString (tokno, GetSymName (moduleSym)), tokno) ; PushT (1) ; BuildAdrFunction ; - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tokno) ; PushTtok (MakeConstString (tokno, GetLibName (moduleSym)), tokno) ; PushT (1) ; BuildAdrFunction ; @@ -2399,12 +2399,12 @@ BEGIN PushTF (Nil, Address) ; PushTF (Nil, Address) ELSE - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tokno) ; PushTtok (MakeConstString (tokno, GetSymName (depModuleSym)), tokno) ; PushT (1) ; BuildAdrFunction ; - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tokno) ; PushTtok (MakeConstString (tokno, GetLibName (depModuleSym)), tokno) ; PushT (1) ; BuildAdrFunction @@ -2668,7 +2668,7 @@ PROCEDURE BuildStringAdrParam (tok: CARDINAL; name: Name); VAR str, m2strnul: CARDINAL ; BEGIN - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tok) ; str := MakeConstString (tok, name) ; PutConstStringKnown (tok, str, name, FALSE, TRUE) ; m2strnul := DeferMakeConstStringM2nul (tok, str) ; @@ -2772,12 +2772,12 @@ BEGIN (* DeconstructModules (module_name, argc, argv, envp); *) PushTtok (deconstructModules, tok) ; - PushTF(Adr, Address) ; + PushTFtok (Adr, Address, tok) ; PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ; PushT(1) ; BuildAdrFunction ; - PushTF(Adr, Address) ; + PushTFtok (Adr, Address, tok) ; PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ; PushT(1) ; BuildAdrFunction ; @@ -2836,12 +2836,12 @@ BEGIN (* RegisterModule (module_name, init, fini, dependencies); *) PushTtok (RegisterModule, tok) ; - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tok) ; PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ; PushT (1) ; BuildAdrFunction ; - PushTF (Adr, Address) ; + PushTFtok (Adr, Address, tok) ; PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ; PushT (1) ; BuildAdrFunction ; @@ -6422,7 +6422,7 @@ BEGIN THEN MarkAsReadWrite(rw) ; (* pass the address field of an unbounded variable *) - PushTF(Adr, Address) ; + PushTFtok (Adr, Address, OperandTok (pi)) ; PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ; PushT(1) ; BuildAdrFunction ; @@ -6452,7 +6452,7 @@ BEGIN THEN MarkAsReadWrite(rw) ; (* pass the address field of an unbounded variable *) - PushTF(Adr, Address) ; + PushTFtok (Adr, Address, OperandTok (pi)) ; PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ; PushT(1) ; BuildAdrFunction ; @@ -12574,19 +12574,21 @@ BEGIN IF Operator = OrTok THEN CheckBooleanId ; - PopBool (t1, f1) ; + PopBooltok (t1, f1, rightpos) ; PopTtok (Operator, OperatorPos) ; - PopBool (t2, f2) ; + PopBooltok (t2, f2, leftpos) ; Assert (f2=0) ; - PushBool (Merge (t1, t2), f1) + OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ; + PushBooltok (Merge (t1, t2), f1, OperatorPos) ELSIF (Operator = AndTok) OR (Operator = AmbersandTok) THEN CheckBooleanId ; - PopBool (t1, f1) ; + PopBooltok (t1, f1, rightpos) ; PopTtok (Operator, OperatorPos) ; - PopBool (t2, f2) ; + PopBooltok (t2, f2, leftpos) ; Assert (t2=0) ; - PushBool (t1, Merge (f1, f2)) + OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ; + PushBooltok (t1, Merge (f1, f2), OperatorPos) ELSE PopTFrwtok (right, righttype, rightrw, rightpos) ; PopTtok (Operator, OperatorPos) ; @@ -12893,7 +12895,7 @@ BEGIN GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE) END ; GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ; - PushBool (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1)) + PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos) ELSIF (OperandT (2) = HashTok) OR (OperandT (2) = LessGreaterTok) THEN (* are the two boolean expressions the different? *) @@ -12909,7 +12911,7 @@ BEGIN GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE) END ; GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ; - PushBool (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1)) + PushBooltok (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1), tokpos) ELSE MetaError0 ('only allowed to use the relation operators {%Ek=} {%Ek#} rather than {%Ek<} or {%Ek>} on {%EkBOOLEAN} expressions as these do not imply an ordinal value for {%kTRUE} or {%kFALSE}') END @@ -13061,7 +13063,7 @@ BEGIN GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, FALSE, leftpos, rightpos, UnknownTokenNo) ; (* True Exit *) GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *) - PushBool (NextQuad-2, NextQuad-1) + PushBooltok (NextQuad-2, NextQuad-1, combinedTok) END END BuildRelOp ; diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf index b22f052c92bc..d69ce2cf17e5 100644 --- a/gcc/m2/gm2-compiler/P2Build.bnf +++ b/gcc/m2/gm2-compiler/P2Build.bnf @@ -104,7 +104,6 @@ FROM P2SymBuild IMPORT P2StartBuildProgramModule, BuildVarientSelector, StartBuildVarientFieldRecord, EndBuildVarientFieldRecord, - BuildNulName, StartBuildArray, EndBuildArray, BuildFieldArray, BuildArrayComma, @@ -861,17 +860,21 @@ CaseLabelList := CaseLabels { "," CaseLabels } =: CaseLabels := ConstExpression [ ".." ConstExpression ] =: -SetType := % VAR ispacked: BOOLEAN ; % +SetType := % VAR ispacked: BOOLEAN ; + setpos : CARDINAL ; % + % setpos := GetTokenNo () % % ispacked := FALSE % ( "SET" % ispacked := FALSE % | "PACKEDSET" % ispacked := TRUE % ) "OF" % BuildNulName % - SimpleType % BuildSetType (ispacked) % + SimpleType % BuildSetType (setpos, ispacked) % =: -PointerType := "POINTER" "TO" % BuildNulName % - Type % BuildPointerType % +PointerType := % VAR pointerpos: CARDINAL ; % + % pointerpos := GetTokenNo () % + "POINTER" "TO" % BuildNulName % + Type % BuildPointerType (pointerpos) % =: ProcedureType := "PROCEDURE" % BuildProcedureType ; % diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def b/gcc/m2/gm2-compiler/P2SymBuild.def index 4f6ad96d8441..89a83144011b 100644 --- a/gcc/m2/gm2-compiler/P2SymBuild.def +++ b/gcc/m2/gm2-compiler/P2SymBuild.def @@ -887,7 +887,7 @@ PROCEDURE BuildNoReturnAttribute (procedureSym: CARDINAL) ; |------------| |-------------| *) -PROCEDURE BuildPointerType ; +PROCEDURE BuildPointerType (pointerpos: CARDINAL) ; (* @@ -906,7 +906,7 @@ PROCEDURE BuildPointerType ; |------------| |-------------| *) -PROCEDURE BuildSetType (ispacked: BOOLEAN) ; +PROCEDURE BuildSetType (setpos: CARDINAL; ispacked: BOOLEAN) ; (* diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod index 17a6e1b71ca3..0b90b762e2ea 100644 --- a/gcc/m2/gm2-compiler/P2SymBuild.mod +++ b/gcc/m2/gm2-compiler/P2SymBuild.mod @@ -26,7 +26,7 @@ FROM libc IMPORT strlen ; FROM NameKey IMPORT Name, MakeKey, makekey, KeyToCharStar, NulName, LengthKey, WriteKey ; FROM StrLib IMPORT StrEqual ; FROM M2Debug IMPORT Assert, WriteDebug ; -FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo ; +FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo, MakeVirtual2Tok ; FROM M2Error IMPORT InternalError, WriteFormat1, WriteFormat2, WriteFormat0, ErrorStringAt, ErrorStringAt2 ; FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1, MetaErrors2, MetaErrorString1 ; FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, Mark, Slice, ConCat, KillString, string ; @@ -2130,25 +2130,27 @@ END BuildNoReturnAttribute ; |------------| |-------------| *) -PROCEDURE BuildPointerType ; +PROCEDURE BuildPointerType (pointerpos: CARDINAL) ; VAR - tok : CARDINAL ; + combined, + namepos, + typepos : CARDINAL ; name : Name ; Type, PtrToType: CARDINAL ; BEGIN - PopTtok(Type, tok) ; - PopT(name) ; - name := CheckAnonymous(name) ; + PopTtok (Type, typepos) ; + PopTtok (name, namepos) ; + name := CheckAnonymous (name) ; - PtrToType := MakePointer(tok, name) ; - PutPointer(PtrToType, Type) ; + combined := MakeVirtual2Tok (pointerpos, typepos) ; + PtrToType := MakePointer (combined, name) ; + PutPointer (PtrToType, Type) ; CheckForExportedImplementation(PtrToType) ; (* May be an exported hidden type *) - PushTtok(name, tok) ; + PushTtok (name, namepos) ; Annotate("%1n|%3d||pointer type name") ; - PushTtok(PtrToType, tok) ; + PushTtok(PtrToType, combined) ; Annotate("%1s(%1d)|%3d||pointer type") - END BuildPointerType ; @@ -2168,21 +2170,24 @@ END BuildPointerType ; |------------| |-------------| *) -PROCEDURE BuildSetType (ispacked: BOOLEAN) ; +PROCEDURE BuildSetType (setpos: CARDINAL; ispacked: BOOLEAN) ; VAR - tok : CARDINAL ; - name : Name ; + combined, + namepos, + typepos : CARDINAL ; + name : Name ; Type, - SetType: CARDINAL ; + SetType : CARDINAL ; BEGIN - PopTtok(Type, tok) ; - PopT(name) ; - SetType := MakeSet (tok, name) ; + PopTtok (Type, typepos) ; + PopTtok (name, namepos) ; + combined := MakeVirtual2Tok (setpos, typepos) ; + SetType := MakeSet (combined, name) ; CheckForExportedImplementation(SetType) ; (* May be an exported hidden type *) PutSet(SetType, Type, ispacked) ; - PushT(name) ; + PushTtok (name, namepos) ; Annotate("%1n||set type name") ; - PushTtok (SetType, tok) ; + PushTtok (SetType, combined) ; Annotate ("%1s(%1d)|%3d||set type|token no") END BuildSetType ; diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index b49cc889dcae..c08de6a97c32 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -99,7 +99,10 @@ IMPORT Indexing ; CONST - DebugUnknowns = FALSE ; + DebugUnknowns = FALSE ; (* Debug unknown symbols. *) + DebugUnknownToken = FALSE ; (* If enabled it will generate a warning every + time a symbol is created with an unknown + location. *) (* The Unbounded is a pseudo type used within the compiler @@ -3265,6 +3268,29 @@ BEGIN END GetModuleCtors ; +(* + CheckTok - checks to see that tok is at a known location. If not + it uses GetTokenNo as a fall back. +*) + +PROCEDURE CheckTok (tok: CARDINAL; name: ARRAY OF CHAR) : CARDINAL ; +VAR + s: String ; +BEGIN + IF tok = UnknownTokenNo + THEN + tok := GetTokenNo () ; + IF DebugUnknownToken + THEN + s := InitString (name) ; + s := ConCat (s, InitString (' symbol {%W} has been created with an unknown token location')) ; + MetaErrorStringT0 (GetTokenNo (), s) + END + END ; + RETURN tok +END CheckTok ; + + (* MakeModule - creates a module sym with ModuleName. It returns the symbol index. @@ -3276,6 +3302,7 @@ VAR pCall: PtrToCallFrame ; Sym : CARDINAL ; BEGIN + (* tok := CheckTok (tok, 'module') ; *) (* Make a new symbol since we are at the outer scope level. DeclareSym examines the current scope level for any symbols @@ -3645,7 +3672,7 @@ BEGIN (* We cannot use DeclareSym as it examines the current scope *) (* for any symbols which have the correct name, but are yet *) (* undefined. *) - + (* tok := CheckTok (tok, 'defimp') ; *) NewSym(Sym) ; pSym := GetPsym(Sym) ; WITH pSym^ DO @@ -3893,6 +3920,7 @@ VAR pSym: PtrToSymbol ; Sym : CARDINAL ; BEGIN + tok := CheckTok (tok, 'procedure') ; Sym := DeclareSym(tok, ProcedureName) ; IF NOT IsError(Sym) THEN @@ -4466,6 +4494,7 @@ PROCEDURE MakeRecord (tok: CARDINAL; RecordName: Name) : CARDINAL ; VAR oaf, sym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'record') ; sym := HandleHiddenOrDeclare (tok, RecordName, oaf) ; FillInRecordFields (tok, sym, RecordName, GetCurrentScope (), oaf) ; ForeachOAFamily (oaf, doFillInOAFamily) ; @@ -4483,6 +4512,7 @@ VAR pSym: PtrToSymbol ; Sym : CARDINAL ; BEGIN + tok := CheckTok (tok, 'varient') ; NewSym (Sym) ; pSym := GetPsym(Sym) ; WITH pSym^ DO @@ -4632,6 +4662,7 @@ VAR pSym : PtrToSymbol ; sym, oaf: CARDINAL ; BEGIN + tok := CheckTok (tok, 'enumeration') ; sym := CheckForHiddenType (EnumerationName) ; IF sym=NulSym THEN @@ -4723,6 +4754,7 @@ VAR pSym: PtrToSymbol ; Sym : CARDINAL ; BEGIN + tok := CheckTok (tok, 'hidden') ; Sym := DeclareSym (tok, TypeName) ; IF NOT IsError(Sym) THEN @@ -4835,6 +4867,7 @@ VAR str: String ; sym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'constant') ; str := Sprintf1 (Mark (InitString ("%d")), value) ; sym := MakeConstLit (tok, makekey (string (str)), Cardinal) ; str := KillString (str) ; @@ -4970,6 +5003,7 @@ PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : C VAR sym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'constlit') ; sym := LookupConstLitPoolEntry (tok, constName, constType) ; IF sym = NulSym THEN @@ -5100,6 +5134,7 @@ PROCEDURE MakeConstStringCnul (tok: CARDINAL; name: Name; known: BOOLEAN) : CARD VAR newstr: CARDINAL ; BEGIN + tok := CheckTok (tok, 'conststringcnul') ; NewSym (newstr) ; InitConstString (tok, newstr, name, name, cnulstr, TRUE, known) ; RETURN newstr @@ -5970,6 +6005,7 @@ VAR pSym : PtrToSymbol ; sym, oaf: CARDINAL ; BEGIN + tok := CheckTok (tok, 'subrange') ; sym := HandleHiddenOrDeclare (tok, SubrangeName, oaf) ; IF NOT IsError(sym) THEN @@ -7739,6 +7775,7 @@ END IsComponent ; PROCEDURE MakeTemporary (tok: CARDINAL; Mode: ModeOfAddr) : CARDINAL ; BEGIN + tok := CheckTok (tok, 'temporary') ; RETURN buildTemporary (tok, Mode, FALSE, NulSym) END MakeTemporary ; @@ -10122,6 +10159,7 @@ VAR pSym : PtrToSymbol ; VariableSym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'parameter') ; VariableSym := MakeVar (tok, ParamName) ; pSym := GetPsym (VariableSym) ; WITH pSym^ DO @@ -10604,6 +10642,7 @@ PROCEDURE MakeParameterHeapVar (tok: CARDINAL; type: CARDINAL; mode: ModeOfAddr) VAR heapvar: CARDINAL ; BEGIN + tok := CheckTok (tok, 'parameter heap var') ; heapvar := NulSym ; type := SkipType (type) ; IF IsPointer (type) @@ -11079,6 +11118,7 @@ PROCEDURE MakePointer (tok: CARDINAL; PointerName: Name) : CARDINAL ; VAR oaf, sym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'pointer') ; sym := HandleHiddenOrDeclare(tok, PointerName, oaf) ; FillInPointerFields(sym, PointerName, GetCurrentScope(), oaf) ; ForeachOAFamily(oaf, doFillInOAFamily) ; @@ -11341,6 +11381,7 @@ VAR pSym : PtrToSymbol ; oaf, sym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'set') ; sym := HandleHiddenOrDeclare(tok, SetName, oaf) ; IF NOT IsError(sym) THEN @@ -11680,6 +11721,7 @@ PROCEDURE MakeUnbounded (tok: CARDINAL; VAR sym, oaf: CARDINAL ; BEGIN + tok := CheckTok (tok, 'unbounded') ; oaf := MakeOAFamily(SimpleType) ; sym := GetUnbounded(oaf, ndim) ; IF sym=NulSym @@ -12513,6 +12555,7 @@ VAR pSym : PtrToSymbol ; oaf, sym: CARDINAL ; BEGIN + tok := CheckTok (tok, 'proctype') ; sym := HandleHiddenOrDeclare (tok, ProcTypeName, oaf) ; IF NOT IsError(sym) THEN -- 2.43.5