From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1499) id 606983858D1E; Tue, 29 Nov 2022 15:10:05 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 606983858D1E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1669734605; bh=z+cu5IDycQxJxptlzh/8a0f69ljbuw9ytCk+JuEqnhY=; h=From:To:Subject:Date:From; b=gIqpkC4kPpKssXfLEzMzSx4CyyjPYwzOBVK0lTU1xG3hCxQcWkcqV8PgdUx+1Uw63 iYGM5P8GJRi4Emcq+f6ymwQZkmIsgzKD8AljLXx3cUWR/AGKxCtaP6UE4fQdJIQs2g 5iyVTxTtNFUpgkE2S8MmnHXocJWi9SND0djbzkT4= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Gaius Mulley To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/modula-2] Bugfix to detect re-assigning a constant array in a code block. X-Act-Checkin: gcc X-Git-Author: Gaius Mulley X-Git-Refname: refs/heads/devel/modula-2 X-Git-Oldrev: 806751e5e9490cc195581681b2b7eeb044b864f5 X-Git-Newrev: 5d09bba11a76e7488d29955eb823bad5a7a6f251 Message-Id: <20221129151005.606983858D1E@sourceware.org> Date: Tue, 29 Nov 2022 15:10:05 +0000 (GMT) List-Id: https://gcc.gnu.org/g:5d09bba11a76e7488d29955eb823bad5a7a6f251 commit 5d09bba11a76e7488d29955eb823bad5a7a6f251 Author: Gaius Mulley Date: Tue Nov 29 14:49:41 2022 +0000 Bugfix to detect re-assigning a constant array in a code block. These patches detect re-assigning a constant array. The patches also correct the token position for aggregate constants. gcc/m2/ChangeLog: * gm2-compiler/M2AsmUtil.mod * gm2-compiler/M2Quads.def (PushTFntok): Exported. (PopConstructor) Exported. (BuildConstructor): Add parameter. (BuildConstructorStart): Add parameter. (BuildConstructorEnd): Add parameter. (BuildComponentValue): Improved comment. * gm2-compiler/M2Quads.mod (SymbolTable): Import list inserted identifiers IsVarConst, PutVarConst and PutDeclared. (BuildConstructorStart): Add parameter. (BuildConstructorEnd): Add parameter. (BuildAssignment): Detect assignment to a constant. (BuildDesignatorArray): Detect assignment to a constant. (BuildStaticArray): Detect assignment to a constant. (BuildDynamicArray): Improve comments. (PushConstructor): Improve comments. (NextConstructorField): Improve comments. (BuildConstructor): Add parameter and use token position of type and parameter. * gm2-compiler/PCBuild.bnf (M2Quads): Import PopConstructor and PushTFntok. (ErrorStringAt): New procedure. * gm2-compiler/PCSymBuild.mod (PushConstructorCastType): Propagate token position. * gm2-compiler/PHBuild.bnf (Constructor): BuildConstructorStart pass token position of {. BuildConstructorEnd pass token position of }. * gm2-compiler/SymbolTable.def (PutVarConst): Exported. (IsVarConst) Exported. * gm2-compiler/SymbolTable.mod (PutVarConst): New procedure. (IsVarConst) New procedure function. Signed-off-by: Gaius Mulley Diff: --- gcc/m2/gm2-compiler/M2AsmUtil.mod | 3 +- gcc/m2/gm2-compiler/M2Quads.def | 24 ++++++-- gcc/m2/gm2-compiler/M2Quads.mod | 114 +++++++++++++++++++++++++----------- gcc/m2/gm2-compiler/P3Build.bnf | 5 +- gcc/m2/gm2-compiler/PCBuild.bnf | 77 +++++++++++++++--------- gcc/m2/gm2-compiler/PCSymBuild.mod | 6 +- gcc/m2/gm2-compiler/PHBuild.bnf | 4 +- gcc/m2/gm2-compiler/SymbolTable.def | 16 +++++ gcc/m2/gm2-compiler/SymbolTable.mod | 48 +++++++++++++++ 9 files changed, 219 insertions(+), 78 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.mod b/gcc/m2/gm2-compiler/M2AsmUtil.mod index 7fc54cd22ed..3440b1d5dbf 100644 --- a/gcc/m2/gm2-compiler/M2AsmUtil.mod +++ b/gcc/m2/gm2-compiler/M2AsmUtil.mod @@ -69,8 +69,7 @@ END StringToKey ; PROCEDURE GetFullScopeAsmName (sym: CARDINAL) : Name ; VAR - leader, - module: String ; + leader: String ; scope : CARDINAL ; BEGIN scope := GetScope (sym) ; diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index 113ce09cb98..148c6b8f918 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -81,7 +81,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile, Top, PopTF, PushTF, PopT, PushT, PopNothing, PopN, PushTFA, PushTtok, PushTFtok, PopTFtok, PopTtok, PushTFAtok, - PushTFn, PopTFn, + PushTFn, PushTFntok, PopTFn, OperandT, OperandF, OperandA, OperandAnno, OperandTok, DisplayStack, WriteOperand, Annotate, @@ -93,6 +93,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile, BuildConstructorStart, BuildConstructorEnd, NextConstructorField, BuildTypeForConstructor, + PopConstructor, BuildComponentValue, SilentBuildConstructor, SilentBuildConstructorStart, @@ -1971,7 +1972,7 @@ PROCEDURE SilentBuildConstructorStart ; |------------+ *) -PROCEDURE BuildConstructor ; +PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ; (* @@ -1986,7 +1987,7 @@ PROCEDURE BuildConstructor ; |------------+ |------------| *) -PROCEDURE BuildConstructorStart ; +PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ; (* @@ -2004,7 +2005,7 @@ PROCEDURE BuildConstructorStart ; |------------+ |------------| *) -PROCEDURE BuildConstructorEnd ; +PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ; (* @@ -2042,6 +2043,13 @@ PROCEDURE BuildTypeForConstructor ; PROCEDURE BuildComponentValue ; +(* + PopConstructor - removes the top constructor from the top of stack. +*) + +PROCEDURE PopConstructor ; + + (* BuildNot - Builds a NOT operation from the quad stack. The Stack is expected to contain: @@ -2258,6 +2266,14 @@ PROCEDURE PopTtok (VAR True: WORD; VAR tok: CARDINAL) ; PROCEDURE PushTFn (True, False, n: WORD) ; +(* + PushTFntok - Push a True and False numbers onto the True/False stack. + True and False are assumed to contain Symbols or Ident etc. +*) + +PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ; + + (* PopTFn - Pop a True and False number from the True/False stack. True and False are assumed to contain Symbols or Ident etc. diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 5be8e770ec2..a7c3acac166 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -84,6 +84,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, PutWriteQuad, RemoveWriteQuad, PutPriority, GetPriority, PutProcedureBegin, PutProcedureEnd, + PutVarConst, IsVarConst, IsVarParam, IsProcedure, IsPointer, IsParameter, IsUnboundedParam, IsEnumeration, IsDefinitionForC, IsVarAParam, IsVarient, IsLegal, @@ -104,6 +105,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, IsPartialUnbounded, IsProcedureBuiltin, IsSet, IsConstSet, IsConstructor, PutConst, PutConstructor, PutConstructorFrom, + PutDeclared, MakeComponentRecord, MakeComponentRef, IsSubscript, IsTemporary, @@ -3359,16 +3361,21 @@ VAR combinedtok: CARDINAL ; BEGIN des := OperandT (2) ; - IF IsConst (des) + IF IsConst (des) OR IsVarConst (des) THEN destok := OperandTok (2) ; exptok := OperandTok (1) ; + exp := OperandT (1) ; IF DebugTokPos THEN MetaErrorT1 (destok, 'destok {%1Ead}', des) ; MetaErrorT1 (exptok, 'exptok {%1Ead}', exp) END ; combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ; + IF DebugTokPos + THEN + MetaErrorT1 (combinedtok, 'combined {%1Ead}', des) + END ; IF IsBoolean (1) THEN MetaErrorT1 (combinedtok, @@ -3489,24 +3496,24 @@ BEGIN combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ; IF (GetSType (Des) # NulSym) AND (NOT IsSet (GetDType (Des))) THEN - (* tell code generator to test runtime values of assignment so ensure we - catch overflow and underflow *) + (* Tell code generator to test runtime values of assignment so ensure we + catch overflow and underflow. *) BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp)) END ; IF checkTypes THEN CheckBecomesMeta (Des, Exp) END ; - (* Traditional Assignment *) + (* Traditional Assignment. *) MoveWithMode (becomesTokNo, Des, Exp, Array, destok, exptok, checkOverflow) ; IF checkTypes THEN (* IF (CannotCheckTypeInPass3 (Des) OR CannotCheckTypeInPass3 (Exp)) THEN - (* we must do this after the assignment to allow the Designator to be - resolved (if it is a constant) before the type checking is done *) - (* prompt post pass 3 to check the assignment once all types are resolved *) + (* We must do this after the assignment to allow the Designator to be + resolved (if it is a constant) before the type checking is done. *) + (* Prompt post pass 3 to check the assignment once all types are resolved. *) BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp)) END ; *) @@ -11019,6 +11026,7 @@ BEGIN PushTFtok (t, GetSType(t), exprTok) ; PushTtok (Sym, arrayTok) ; combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ; + PutVarConst (t, TRUE) ; BuildAssignConstant (combinedTok) ; PushTFDtok (t, GetDType(t), d, arrayTok) ; PushTtok (e, exprTok) @@ -11100,6 +11108,11 @@ BEGIN (* now make Adr point to the address of the indexed element *) combinedTok := MakeVirtualTok (arrayTok, arrayTok, indexTok) ; Adr := MakeTemporary (combinedTok, LeftValue) ; + IF IsVar (Array) + THEN + (* BuildDesignatorArray may have detected des is a constant. *) + PutVarConst (Adr, IsVarConst (Array)) + END ; (* From now on it must reference the array element by its lvalue - so we create the type of the referenced entity @@ -11201,16 +11214,13 @@ BEGIN IF Dim = 1 THEN (* - Base has type address because + Base has type address since BuildDesignatorRecord references by address. Build a record for retrieving the address of dynamic array. BuildDesignatorRecord will generate the required quadruples, therefore build sets up the stack for BuildDesignatorRecord which will generate the quads to access the record. - - Build above current current info needed for array. - Note that, n, has gone by now. *) ArraySym := Sym ; UnboundedType := GetUnboundedRecordType(GetSType(Sym)) ; @@ -11846,7 +11856,7 @@ PROCEDURE PopConstructor ; VAR c: ConstructorFrame ; BEGIN - c := PopAddress(ConstructorStack) ; + c := PopAddress (ConstructorStack) ; DISPOSE(c) END PopConstructor ; @@ -11870,7 +11880,7 @@ END NextConstructorField ; PROCEDURE SilentBuildConstructor ; BEGIN - PutConstructorIntoFifoQueue(NulSym) + PutConstructorIntoFifoQueue (NulSym) END SilentBuildConstructor ; @@ -11886,28 +11896,28 @@ END SilentBuildConstructor ; |------------+ *) -PROCEDURE BuildConstructor ; +PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ; VAR tok : CARDINAL ; constValue, type : CARDINAL ; BEGIN - PopT(type) ; - tok := GetTokenNo () ; - constValue := MakeTemporary(tok, ImmediateValue) ; - PutVar(constValue, type) ; - PutConstructor(constValue) ; - PushValue(constValue) ; - IF type=NulSym + PopTtok (type, tok) ; + constValue := MakeTemporary (tok, ImmediateValue) ; + PutVar (constValue, type) ; + PutConstructor (constValue) ; + PushValue (constValue) ; + IF type = NulSym THEN - WriteFormat0('constructor requires a type before the opening {') + MetaErrorT0 (tokcbrpos, + '{%E}constructor requires a type before the opening {') ELSE - ChangeToConstructor(GetTokenNo(), type) ; - PutConstructorFrom(constValue, type) ; - PopValue(constValue) ; - PutConstructorIntoFifoQueue(constValue) + ChangeToConstructor (tok, type) ; + PutConstructorFrom (constValue, type) ; + PopValue (constValue) ; + PutConstructorIntoFifoQueue (constValue) END ; - PushConstructor(type) + PushConstructor (type) END BuildConstructor ; @@ -11919,7 +11929,7 @@ PROCEDURE SilentBuildConstructorStart ; VAR constValue: CARDINAL ; BEGIN - GetConstructorFromFifoQueue(constValue) + GetConstructorFromFifoQueue (constValue) END SilentBuildConstructorStart ; @@ -11935,16 +11945,16 @@ END SilentBuildConstructorStart ; |------------+ |----------------| *) -PROCEDURE BuildConstructorStart ; +PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ; VAR constValue, type : CARDINAL ; BEGIN - PopT(type) ; (* we ignore the type as we already have the constructor symbol from pass C *) - GetConstructorFromFifoQueue(constValue) ; - Assert(type=GetSType(constValue)) ; - PushT(constValue) ; - PushConstructor(type) + PopT (type) ; (* we ignore the type as we already have the constructor symbol from pass C *) + GetConstructorFromFifoQueue (constValue) ; + Assert (type = GetSType (constValue)) ; + PushTtok (constValue, cbratokpos) ; + PushConstructor (type) END BuildConstructorStart ; @@ -11961,9 +11971,23 @@ END BuildConstructorStart ; |------------| |------------| *) -PROCEDURE BuildConstructorEnd ; +PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ; +VAR + type, typetok, + value, valtok: CARDINAL ; BEGIN + PopTtok (value, valtok) ; + IF IsBoolean (1) + THEN + typetok := valtok + ELSE + typetok := OperandTtok (1) + END ; + valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ; + PutDeclared (valtok, value) ; + PushTtok (value, valtok) ; (* Use valtok as we now know it was a constructor. *) PopConstructor + (* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *) END BuildConstructorEnd ; @@ -14685,6 +14709,26 @@ BEGIN END PushTFn ; +(* + PushTFntok - Push a True and False numbers onto the True/False stack. + True and False are assumed to contain Symbols or Ident etc. +*) + +PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ; +VAR + f: BoolFrame ; +BEGIN + f := newBoolFrame () ; + WITH f^ DO + TrueExit := True ; + FalseExit := False ; + name := n ; + tokenno := tokno + END ; + PushAddress (BoolStack, f) +END PushTFntok ; + + (* PopTFn - Pop a True and False number from the True/False stack. True and False are assumed to contain Symbols or Ident etc. diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf index 9f5dbb3536d..79ebab5eb94 100644 --- a/gcc/m2/gm2-compiler/P3Build.bnf +++ b/gcc/m2/gm2-compiler/P3Build.bnf @@ -747,8 +747,9 @@ ArraySetRecordValue := ComponentValue % Bui } =: -Constructor := '{' % BuildConstructorStart % - [ ArraySetRecordValue ] % BuildConstructorEnd % +Constructor := % DisplayStack % + '{' % BuildConstructorStart (GetTokenNo() -1) % + [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) % '}' =: ConstSetOrQualidentOrFunction := Qualident diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf index 7db36e8dfd6..40fc1e63923 100644 --- a/gcc/m2/gm2-compiler/PCBuild.bnf +++ b/gcc/m2/gm2-compiler/PCBuild.bnf @@ -62,9 +62,10 @@ FROM M2Reserved IMPORT tokToTok, toktype, AndTok, AmbersandTok, PeriodPeriodTok, ByTok ; FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA, - PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, + PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, PushTFntok, PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, BuildTypeForConstructor, BuildConstructor, BuildConstructorEnd, + PopConstructor, NextConstructorField, SilentBuildConstructor ; FROM P3SymBuild IMPORT CheckCanBeImported ; @@ -130,17 +131,23 @@ VAR PROCEDURE ErrorString (s: String) ; BEGIN - ErrorStringAt(s, GetTokenNo()) ; + ErrorStringAt (s, GetTokenNo ()) ; WasNoError := FALSE END ErrorString ; PROCEDURE ErrorArray (a: ARRAY OF CHAR) ; BEGIN - ErrorString(InitString(a)) + ErrorString (InitString (a)) END ErrorArray ; +PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ; +BEGIN + ErrorStringAt (InitString(a), tok) +END ErrorArrayAt ; + + % declaration PCBuild begin @@ -344,7 +351,7 @@ PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop BEGIN IF IsAutoPushOn() THEN - PushTF(makekey(currentstring), identtok) + PushTFtok (makekey (currentstring), identtok, GetTokenNo ()) END ; Expect(identtok, stopset0, stopset1, stopset2) END Ident ; @@ -681,8 +688,8 @@ ArraySetRecordValue := ComponentValue { ',' % Nex Constructor := '{' % PushConstructorCastType % % PushInConstructor % - % BuildConstructor % - [ ArraySetRecordValue ] % BuildConstructorEnd % + % BuildConstructor (GetTokenNo ()-1) % + [ ArraySetRecordValue ] % PopConstructor % '}' % PopInConstructor % =: @@ -926,50 +933,64 @@ Term := Factor { MulOperator Factor } =: Factor := Number | string | SetOrDesignatorOrFunction | "(" Expression ")" | "NOT" ( Factor | ConstAttribute ) =: -PushQualident := % VAR name : Name ; - init, ip1: CARDINAL ; % +PushQualident := % VAR name : Name ; + init, ip1 : CARDINAL ; + tok, tokstart: CARDINAL ; % % PushAutoOn % Ident % IF IsAutoPushOn() THEN - PopT(name) ; - init := GetSym(name) ; + PopTtok (name, tokstart) ; + tok := tokstart ; + init := GetSym (name) ; IF init=NulSym THEN - PushTFn(NulSym, NulSym, name) + PushTFntok (NulSym, NulSym, name, tok) ELSE - WHILE IsDefImp(init) OR IsModule(init) DO - IF currenttoken#periodtok + WHILE IsDefImp (init) OR IsModule (init) DO + IF currenttoken # periodtok THEN - ErrorArray("expecting '.' after module in the construction of a qualident") ; - PushT(init) ; + ErrorArrayAt ("expecting '.' after module in the construction of a qualident", tok) ; + IF tok#tokstart + THEN + tok := MakeVirtualTok (tokstart, tokstart, tok) + END ; + PushTtok (init, tok) ; PopAuto ; RETURN ELSE - Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ; - StartScope(init) ; - Ident(stopset0, stopset1, stopset2) ; - PopT(name) ; - ip1 := GetSym(name) ; - IF ip1=NulSym + Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ; + StartScope (init) ; + Ident (stopset0, stopset1, stopset2) ; + PopTtok (name, tok) ; + ip1 := GetSym (name) ; + IF ip1 = NulSym THEN - ErrorArray("unknown ident in the construction of a qualident") ; + ErrorArrayAt ("unknown ident in the construction of a qualident", tok) ; EndScope ; - PushTFn(NulSym, NulSym, name) ; + IF tok#tokstart + THEN + tok := MakeVirtualTok (tokstart, tokstart, tok) + END ; + PushTFntok (NulSym, NulSym, name, tok) ; PopAuto ; RETURN ELSE - PutIncluded(ip1) + PutIncluded (ip1) END ; EndScope ; - CheckCanBeImported(init, ip1) ; + CheckCanBeImported (init, ip1) ; init := ip1 END END ; - IF IsProcedure(init) OR IsProcType(init) + IF tok#tokstart + THEN + tok := MakeVirtualTok (tokstart, tokstart, tok) + END ; + IF IsProcedure (init) OR IsProcType (init) THEN - PushT(init) + PushTtok (init, tok) ELSE - PushTF(init, GetType(init)) + PushTFtok (init, GetType(init), tok) END END ELSE % diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod index 7e11b0ea014..f3d3afce8f0 100644 --- a/gcc/m2/gm2-compiler/PCSymBuild.mod +++ b/gcc/m2/gm2-compiler/PCSymBuild.mod @@ -1326,14 +1326,10 @@ END PushConstType ; *) PROCEDURE PushConstructorCastType ; -VAR - c: CARDINAL ; BEGIN - PopT(c) ; - PushT(c) ; IF inDesignator THEN - InitConvert(cast, c, NIL, NIL) + InitConvert (cast, OperandT (1), NIL, NIL) END END PushConstructorCastType ; diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf index 9efc005327b..16c8f0e1b1c 100644 --- a/gcc/m2/gm2-compiler/PHBuild.bnf +++ b/gcc/m2/gm2-compiler/PHBuild.bnf @@ -695,8 +695,8 @@ ArraySetRecordValue := ComponentValue % Bui } =: -Constructor := '{' % BuildConstructorStart % - [ ArraySetRecordValue ] % BuildConstructorEnd % +Constructor := '{' % BuildConstructorStart (GetTokenNo() -1) % + [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) % '}' =: ConstSetOrQualidentOrFunction := Qualident diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def index 2983ec46fde..c2f25f4e319 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.def +++ b/gcc/m2/gm2-compiler/SymbolTable.def @@ -146,6 +146,7 @@ EXPORT QUALIFIED NulSym, GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList, PutVar, + PutVarConst, PutLeftValueFrontBackType, GetVarBackEndType, PutVarPointerCheck, @@ -227,6 +228,7 @@ EXPORT QUALIFIED NulSym, IsImport, IsImportStatement, IsVar, + IsVarConst, IsConst, IsConstString, IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul, @@ -883,6 +885,13 @@ PROCEDURE PutVariableSSA (sym: CARDINAL; value: BOOLEAN) ; PROCEDURE IsVariableSSA (sym: CARDINAL) : BOOLEAN ; +(* + PutVarConst - sets the IsConst field to value indicating the variable is read only. +*) + +PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ; + + (* MakeGnuAsm - create a GnuAsm symbol. *) @@ -2802,6 +2811,13 @@ PROCEDURE IsProcType (Sym: CARDINAL) : BOOLEAN ; PROCEDURE IsVar (Sym: CARDINAL) : BOOLEAN ; +(* + IsVarConst - returns the IsConst field indicating the variable is read only. +*) + +PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ; + + (* IsConst - returns true is Sym is a Const Symbol. *) diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index 41e9c8a2d99..a2fd8691940 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -456,6 +456,7 @@ TYPE CVariant, NulCVariant : CARDINAL ; (* variants of the same string *) StringVariant : ConstStringVariant ; + Scope : CARDINAL ; (* Scope of declaration. *) At : Where ; (* Where was sym declared/used *) END ; @@ -468,6 +469,7 @@ TYPE IsConstructor: BOOLEAN ; (* is the constant a set? *) FromType : CARDINAL ; (* type is determined FromType *) UnresFromType: BOOLEAN ; (* is Type unresolved? *) + Scope : CARDINAL ; (* Scope of declaration. *) At : Where ; (* Where was sym declared/used *) END ; @@ -481,6 +483,7 @@ TYPE FromType : CARDINAL ; (* type is determined FromType *) UnresFromType: BOOLEAN ; (* is Type resolved? *) IsTemp : BOOLEAN ; (* is it a temporary? *) + Scope : CARDINAL ; (* Scope of declaration. *) At : Where ; (* Where was sym declared/used *) END ; @@ -504,6 +507,7 @@ TYPE (* dereference a pointer? *) IsWritten : BOOLEAN ; (* Is variable written to? *) IsSSA : BOOLEAN ; (* Is variable a SSA? *) + IsConst : BOOLEAN ; (* Is variable read/only? *) At : Where ; (* Where was sym declared/used *) ReadUsageList, (* list of var read quads *) WriteUsageList: LRLists ; (* list of var write quads *) @@ -4081,6 +4085,7 @@ BEGIN IsPointerCheck := FALSE ; IsWritten := FALSE ; IsSSA := FALSE ; + IsConst := FALSE ; InitWhereDeclaredTok(tok, At) ; InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *) InitList(ReadUsageList[RightValue]) ; @@ -4667,6 +4672,7 @@ BEGIN ConstLit.IsConstructor := FALSE ; ConstLit.FromType := NulSym ; (* type is determined FromType *) ConstLit.UnresFromType := FALSE ; (* is Type resolved? *) + ConstLit.Scope := GetCurrentScope() ; InitWhereDeclaredTok (tok, ConstLit.At) ; InitWhereFirstUsedTok (tok, ConstLit.At) @@ -4703,6 +4709,7 @@ BEGIN FromType := NulSym ; (* type is determined FromType *) UnresFromType := FALSE ; (* is Type resolved? *) IsTemp := FALSE ; + Scope := GetCurrentScope() ; InitWhereDeclaredTok (tok, At) END END ; @@ -4811,6 +4818,7 @@ BEGIN m2sym, m2nulsym, csym, cnulsym) ; BackFillString (cnulsym, m2sym, m2nulsym, csym, cnulsym) ; + ConstString.Scope := GetCurrentScope() ; InitWhereDeclaredTok (tok, ConstString.At) ELSE @@ -6578,6 +6586,43 @@ BEGIN END GetVarWritten ; +(* + PutVarConst - sets the IsConst field to value indicating the variable is read only. +*) + +PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ; +VAR + pSym: PtrToSymbol ; +BEGIN + IF IsVar (sym) + THEN + pSym := GetPsym (sym) ; + pSym^.Var.IsConst := value + END +END PutVarConst ; + + +(* + IsVarConst - returns the IsConst field indicating the variable is read only. +*) + +PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ; +VAR + pSym: PtrToSymbol ; +BEGIN + pSym := GetPsym(sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: RETURN( Var.IsConst ) + + ELSE + InternalError ('expecting VarSym') + END + END +END IsVarConst ; + + (* PutConst - gives the constant symbol Sym a type ConstType. *) @@ -11964,6 +12009,9 @@ BEGIN RecordSym : RETURN( Record.Scope ) | SetSym : RETURN( Set.Scope ) | UnboundedSym : RETURN( Unbounded.Scope ) | + ConstLitSym : RETURN( ConstLit.Scope ) | + ConstStringSym : RETURN( ConstString.Scope ) | + ConstVarSym : RETURN( ConstVar.Scope ) | PartialUnboundedSym: InternalError ('should not be requesting the scope of a PartialUnbounded symbol') ELSE