public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Gaius Mulley <gaius@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/modula-2] M2GCCDeclare.mod, M2GenGCC.mod and M2Range.mod removal of unused parameters and variables. Date: Mon, 11 Oct 2021 19:14:37 +0000 (GMT) [thread overview] Message-ID: <20211011191437.413FE3858D35@sourceware.org> (raw) https://gcc.gnu.org/g:d23f74ee5deb74e3ab218d35f613c44b01b4a5a4 commit d23f74ee5deb74e3ab218d35f613c44b01b4a5a4 Author: Gaius Mulley <gaius.mulley@southwales.ac.uk> Date: Mon Oct 11 20:12:19 2021 +0100 M2GCCDeclare.mod, M2GenGCC.mod and M2Range.mod removal of unused parameters and variables. 2021-10-11 Gaius Mulley <gaius.mulley@southwales.ac.uk> gcc/m2/ChangeLog: * gm2-compiler/M2GCCDeclare.mod (mystop): Removed. (DebugSets): Commented out. (TryFindSymbol): Commented out. (DeclareTypePartially): Delete variable t and use Assert to test return values. (NotAllDependantsPartiallyOrFullyDeclared): Commented out. (DeclareTypeFromPartial): Commented out. (DeclarePointerTypeFully): Commented out. (ForeachTryDeclare): Remove unused parameters start and end. (DeclaredOutstandingTypes): Alter all calls to ForeachTryDeclare. (DeclareType): Alter all calls to ForeachTryDeclare. (DeclareStringConstant): Commented out. (PromoteToString): Use tokenno to derive location. (DeclareConstructor): Add location to a call to BuildStringConstant. (TryDeclareConstant): Delete variable tok introduce parameter tokenno. (DeclareConst): Change all calls to BuildConvert to pass the location. (WalkFamilyOfUnbounded): Add location to the calls of DeclareStringConstant. (WalkDependants): Reformatted. (PopBinding): Remove start, end quadruple values from ResolveConstantExpressions. (AssertAllTypesDeclared): delete variable and use Assert to check return result. (DoVariableDeclaration): delete variables s and t. (DeclareImportedVariables): Remove call to AlignDeclarationWithSource. (DeclareLocalVariable): Remove call to AlignDeclarationWithSource. (DeclareEnumeration): Remove call to AlignDeclarationWithSource. (IncludeGetNth): Remove call to AlignDeclarationWithSource. (DeclarePackedSubrange): Reformatted. (WalkVarientDependants): Commented out. (BuildTreeFromInterface): replace variable location. * gm2-compiler/M2GenGCC.mod: (CodeInline): Add tokenno to calls to BuildTreeFromInterface. (CodeAddr): Change call to BuildStringConstant to use location parameter. * gm2-compiler/M2MetaError.mod (InternalFormat): Generate error message using line number. (OutColorS): Commented out. (doGetType): Introduce safely check using HIGH. (doGetSkipType): Introduce safely check using HIGH. (ConCatWord): Commented out. (copySym): Commented out. * gm2-compiler/M2Quads.mod: Remove CheckRangeAddVariableRead and CheckRangeRemoveVariableRead from the import list. * gm2-compiler/M2Range.def (DynamicStrings): Import list commented out identifiers CheckRangeAddVariableRead, CheckRangeRemoveVariableRead. (CheckRangeAddVariableRead): Commented out. * gm2-compiler/M2Range.mod (InitAssignmentRangeCheck): Delete variable p and use Assert to check the return result. (InitReturnRangeCheck): Delete variable p and use Assert to check the return result. (InitSubrangeRangeCheck): Delete variable p and use Assert to check the return result. (InitStaticArraySubscriptRangeCheck): Delete variable p and use Assert to check the return result. (InitDynamicArraySubscriptRangeCheck): Delete variable p and use Assert to check the return result. (InitIncRangeCheck): Delete variable p and use Assert to check the return result. (InitDecRangeCheck): Delete variable p and use Assert to check the return result. (InitInclCheck): Delete variable p and use Assert to check the return result. (InitExclCheck): Delete variable p and use Assert to check the return result. (InitShiftCheck): Delete variable p and use Assert to check the return result. (InitRotateCheck): Delete variable p and use Assert to check the return result. (InitTypesAssignmentCheck): Delete variable p and use Assert to check the return result. (InitTypesParameterCheck): Delete variable p and use Assert to check the return result. (InitTypesExpressionCheck): Delete variable p and use Assert to check the return result. (InitForLoopBeginRangeCheck): Delete variable p and use Assert to check the return result. (InitForLoopToRangeCheck): Delete variable p and use Assert to check the return result. (InitForLoopEndRangeCheck): Delete variable p and use Assert to check the return result. (InitPointerRangeCheck): Delete variable p and use Assert to check the return result. (InitNoReturnRangeCheck): Delete variable p and use Assert to check the return result. (InitNoElseRangeCheck): Delete variable p and use Assert to check the return result. (InitWholeNonPosDivCheck): Delete variable p and use Assert to check the return result. (InitWholeNonPosModCheck): Delete variable p and use Assert to check the return result. (InitWholeZeroDivisionCheck): Delete variable p and use Assert to check the return result. (FoldNil): Delete variable p and use Assert to check the return result. (FoldTypeExpr): Delete variable p and use Assert to check the return result. (CodeTypeExpr): Delete variable p and use Assert to check the return result. (FoldForLoopBegin): Delete variable p and use Assert to check the return result. (MakeAndDeclareConstLit): Delete variable p and use Assert to check the return result. (FoldNonPosMod): Delete variable p and use Assert to check the return result. (FoldZeroDiv): Delete variable p and use Assert to check the return result. (FoldZeroRem): Delete variable p and use Assert to check the return result. (FoldRangeCheck): Delete variable p and use Assert to check the return result. (CodeErrorCheck): Delete variable p and use Assert to check the return result. (CodeInclExcl): Delete variable p and use Assert to check the return result. (DiffTypesCodeForLoopEnd): Delete variable p and use Assert to check the return result. (DiffTypesCodeForLoopEnd): Delete variable p and use Assert to check the return result. (CodeNil): Delete variable p and use Assert to check the return result. (CodeWholeZero): Delete variable p and use Assert to check the return result. (InitCaseBounds): Delete variable p and use Assert to check the return result. (AddVarRead): Delete variable p and use Assert to check the return result. (SubVarRead): Delete variable p and use Assert to check the return result. (CheckRangeAddVariableRead): Delete variable p and use Assert to check the return result. (CheckRangeRemoveVariableRead): Delete variable p and use Assert to check the return result. (WriteRangeCheck): Delete variable p and use Assert to check the return result. * gm2-gcc/m2decl.c: (BuildStringConstant) add location parameter. * gm2-gcc/m2decl.def: (BuildStringConstant) add location parameter. * gm2-gcc/m2decl.h: (BuildStringConstant) add location parameter. Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk> Diff: --- gcc/m2/gm2-compiler/M2GCCDeclare.mod | 352 ++++++++++++----------------------- gcc/m2/gm2-compiler/M2GenGCC.mod | 46 ++--- gcc/m2/gm2-compiler/M2MetaError.mod | 11 +- gcc/m2/gm2-compiler/M2Quads.mod | 4 +- gcc/m2/gm2-compiler/M2Range.def | 8 +- gcc/m2/gm2-compiler/M2Range.mod | 191 +++++++++---------- gcc/m2/gm2-gcc/m2decl.c | 3 +- gcc/m2/gm2-gcc/m2decl.def | 2 +- gcc/m2/gm2-gcc/m2decl.h | 2 +- 9 files changed, 253 insertions(+), 366 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index 9ed6c531e24..e41a70ed01d 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -233,9 +233,7 @@ VAR PROCEDURE mystop ; BEGIN END mystop ; -PROCEDURE stop ; BEGIN END stop ; - - +(* *************************************************** (* PrintNum - *) @@ -273,6 +271,7 @@ BEGIN DebugSet('NilTypedArrays', NilTypedArrays) ; DebugSet('ToBeSolvedByQuads', ToBeSolvedByQuads) END DebugSets ; +************************************************ *) (* @@ -352,6 +351,7 @@ END AddSymToWatch ; TryFindSymbol - *) +(* PROCEDURE TryFindSymbol (module, symname: ARRAY OF CHAR) : CARDINAL ; VAR mn, sn: Name ; @@ -367,6 +367,7 @@ BEGIN RETURN( NulSym ) END END TryFindSymbol ; +*) (* @@ -704,7 +705,6 @@ END CanDeclareTypePartially ; PROCEDURE DeclareTypePartially (sym: CARDINAL) ; VAR - t : Tree ; location: location_t ; BEGIN (* check to see if we have already partially declared the symbol *) @@ -712,22 +712,22 @@ BEGIN THEN IF IsRecord(sym) THEN - Assert(NOT IsElementInSet(HeldByAlignment, sym)) ; - t := DoStartDeclaration(sym, BuildStartRecord) ; - WatchIncludeList(sym, heldbyalignment) - ELSIF IsVarient(sym) + Assert (NOT IsElementInSet (HeldByAlignment, sym)) ; + Assert (DoStartDeclaration (sym, BuildStartRecord) # NIL) ; + WatchIncludeList (sym, heldbyalignment) + ELSIF IsVarient (sym) THEN Assert(NOT IsElementInSet(HeldByAlignment, sym)) ; - t := DoStartDeclaration(sym, BuildStartVarient) ; + Assert (DoStartDeclaration(sym, BuildStartVarient) # NIL) ; WatchIncludeList(sym, heldbyalignment) ELSIF IsFieldVarient(sym) THEN Assert(NOT IsElementInSet(HeldByAlignment, sym)) ; - t := DoStartDeclaration(sym, BuildStartFieldVarient) ; + Assert (DoStartDeclaration(sym, BuildStartFieldVarient) # NIL) ; WatchIncludeList(sym, heldbyalignment) ELSIF IsProcType(sym) THEN - t := DoStartDeclaration(sym, BuildStartFunctionType) + Assert (DoStartDeclaration(sym, BuildStartFunctionType) # NIL) ; ELSIF IsType(sym) THEN IF NOT GccKnowsAbout(sym) @@ -1024,10 +1024,12 @@ END AllDependantsPartiallyOrFullyDeclared ; declared. *) +(* PROCEDURE NotAllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ; BEGIN RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) ) END NotAllDependantsPartiallyOrFullyDeclared ; +*) (* @@ -1152,6 +1154,7 @@ END DeclareTypeFromPartial ; declare it. *) +(* PROCEDURE DeclarePointerTypeFully (sym: CARDINAL) ; BEGIN IF IsPointer(sym) @@ -1167,6 +1170,7 @@ BEGIN TraverseDependants(sym) END END DeclarePointerTypeFully ; +*) (* @@ -1273,8 +1277,7 @@ END Body ; end *) -PROCEDURE ForeachTryDeclare (start, end: CARDINAL; - t: ListType; l: Set; r: Rule; +PROCEDURE ForeachTryDeclare (t: ListType; l: Set; r: Rule; q: IsAction; p: WalkAction) : BOOLEAN ; BEGIN IF recursionCaught @@ -1298,56 +1301,13 @@ BEGIN END ForeachTryDeclare ; -(* - testThis - -*) - -PROCEDURE testThis ; -VAR - t : Tree ; - type, - pointer, - array : CARDINAL ; - location: location_t ; -BEGIN - array := 628 ; - IF NOT GccKnowsAbout(array) - THEN - PreAddModGcc(array, BuildStartArrayType(BuildIndex(GetDeclaredMod(array), array), NIL, GetDType(array))) - END ; - pointer := 626 ; - IF NOT GccKnowsAbout(pointer) - THEN - PreAddModGcc(pointer, BuildPointerType(Mod2Gcc(array))) - END ; - type := 627 ; - IF NOT GccKnowsAbout(type) - THEN - location := TokenToLocation(GetDeclaredMod(type)) ; - PreAddModGcc(type, BuildStartType(location, - KeyToCharStar(GetFullSymName(type)), - Mod2Gcc(pointer))) ; - PutArrayType(Mod2Gcc(array), Mod2Gcc(type)) ; - t := BuildEndType(location, Mod2Gcc(type)) ; - WatchRemoveList(type, todolist) ; - WatchIncludeList(type, fullydeclared) ; - WatchRemoveList(pointer, todolist) ; - WatchIncludeList(pointer, fullydeclared) ; - t := DeclareArray(array) ; - WatchIncludeList(array, fullydeclared) ; - WatchRemoveList(array, todolist) - END -END testThis ; - - (* DeclaredOutandingTypes - writes out any types that have their dependants solved. It returns TRUE if all outstanding types have been written. *) -PROCEDURE DeclaredOutstandingTypes (MustHaveCompleted: BOOLEAN; - start, end: CARDINAL) : BOOLEAN ; +PROCEDURE DeclaredOutstandingTypes (MustHaveCompleted: BOOLEAN) : BOOLEAN ; VAR finished : BOOLEAN ; d, a, p, f, n, b: CARDINAL ; @@ -1360,86 +1320,75 @@ BEGIN b := 0 ; finished := FALSE ; REPEAT - IF FindSetNumbers(d, a, p, f, n, b) OR Progress + IF FindSetNumbers (d, a, p, f, n, b) OR Progress THEN DebugSetNumbers END ; - IF ForeachTryDeclare(start, end, - todolist, ToDoList, - partialtype, - CanDeclareTypePartially, - DeclareTypePartially) + IF ForeachTryDeclare (todolist, ToDoList, + partialtype, + CanDeclareTypePartially, + DeclareTypePartially) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - todolist, ToDoList, - arraynil, - CanDeclareArrayAsNil, - DeclareArrayAsNil) + ELSIF ForeachTryDeclare (todolist, ToDoList, + arraynil, + CanDeclareArrayAsNil, + DeclareArrayAsNil) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - todolist, ToDoList, - pointernilarray, - CanDeclarePointerToNilArray, - DeclarePointerToNilArray) + ELSIF ForeachTryDeclare (todolist, ToDoList, + pointernilarray, + CanDeclarePointerToNilArray, + DeclarePointerToNilArray) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - niltypedarrays, NilTypedArrays, - arraypartial, - CanDeclareArrayPartially, - DeclareArrayPartially) + ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays, + arraypartial, + CanDeclareArrayPartially, + DeclareArrayPartially) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - niltypedarrays, NilTypedArrays, - pointerfully, - CanPromotePointerFully, - PromotePointerFully) + ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays, + pointerfully, + CanPromotePointerFully, + PromotePointerFully) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - heldbyalignment, HeldByAlignment, - recordkind, - CanDeclareRecordKind, - DeclareRecordKind) + ELSIF ForeachTryDeclare (heldbyalignment, HeldByAlignment, + recordkind, + CanDeclareRecordKind, + DeclareRecordKind) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - finishedalignment, FinishedAlignment, - recordfully, - CanDeclareRecord, - FinishDeclareRecord) + ELSIF ForeachTryDeclare (finishedalignment, FinishedAlignment, + recordfully, + CanDeclareRecord, + FinishDeclareRecord) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - todolist, ToDoList, - typeconstfully, - TypeConstDependantsFullyDeclared, - DeclareTypeConstFully) + ELSIF ForeachTryDeclare (todolist, ToDoList, + typeconstfully, + TypeConstDependantsFullyDeclared, + DeclareTypeConstFully) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - todolist, ToDoList, - (* partiallydeclared, PartiallyDeclared, *) - typefrompartial, - CanBeDeclaredViaPartialDependants, - DeclareTypeFromPartial) + ELSIF ForeachTryDeclare (todolist, ToDoList, + (* partiallydeclared, PartiallyDeclared, *) + typefrompartial, + CanBeDeclaredViaPartialDependants, + DeclareTypeFromPartial) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - partiallydeclared, PartiallyDeclared, - partialfrompartial, - CanBeDeclaredPartiallyViaPartialDependants, - DeclareTypePartially) + ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared, + partialfrompartial, + CanBeDeclaredPartiallyViaPartialDependants, + DeclareTypePartially) THEN (* continue looping *) - ELSIF ForeachTryDeclare(start, end, - partiallydeclared, PartiallyDeclared, - partialtofully, - TypeConstDependantsFullyDeclared, - DeclareTypeConstFully) + ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared, + partialtofully, + TypeConstDependantsFullyDeclared, + DeclareTypeConstFully) THEN (* continue looping *) ELSE @@ -1449,27 +1398,24 @@ BEGIN UNTIL finished ; IF MustHaveCompleted THEN - IF ForeachTryDeclare(start, end, - todolist, ToDoList, - circulartodo, - NotAllDependantsFullyDeclared, - EmitCircularDependancyError) + IF ForeachTryDeclare (todolist, ToDoList, + circulartodo, + NotAllDependantsFullyDeclared, + EmitCircularDependancyError) THEN - ELSIF ForeachTryDeclare(start, end, - partiallydeclared, PartiallyDeclared, - circularpartial, - NotAllDependantsPartiallyDeclared, - EmitCircularDependancyError) + ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared, + circularpartial, + NotAllDependantsPartiallyDeclared, + EmitCircularDependancyError) THEN - ELSIF ForeachTryDeclare(start, end, - niltypedarrays, NilTypedArrays, - circularniltyped, - NotAllDependantsPartiallyDeclared, - EmitCircularDependancyError) + ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays, + circularniltyped, + NotAllDependantsPartiallyDeclared, + EmitCircularDependancyError) THEN END END ; - RETURN( NoOfElementsInSet(ToDoList)=0 ) + RETURN NoOfElementsInSet (ToDoList) = 0 END DeclaredOutstandingTypes ; @@ -1538,12 +1484,14 @@ END DeclareType ; DeclareIntegerConstant - declares an integer constant. *) +(* PROCEDURE DeclareIntegerConstant (sym: CARDINAL; value: INTEGER) ; BEGIN PreAddModGcc(sym, BuildIntegerConstant(value)) ; WatchRemoveList(sym, todolist) ; WatchIncludeList(sym, fullydeclared) END DeclareIntegerConstant ; +*) (* @@ -1577,16 +1525,12 @@ END DeclareCharConstant ; DeclareStringConstant - declares a string constant. *) -PROCEDURE DeclareStringConstant (sym: CARDINAL) ; +PROCEDURE DeclareStringConstant (tokenno: CARDINAL; sym: CARDINAL) ; VAR - location: location_t ; symtree : Tree ; + location: location_t ; BEGIN - IF sym = 12066 - THEN - stop - END ; - location := TokenToLocation(GetDeclaredMod(sym)) ; + location := TokenToLocation (tokenno) ; IF IsConstStringM2nul (sym) OR IsConstStringCnul (sym) THEN (* in either case the string needs a nul terminator. If the string @@ -1595,12 +1539,13 @@ BEGIN symtree := BuildCStringConstant (KeyToCharStar (GetString (sym)), GetStringLength (sym)) ELSE - symtree := BuildStringConstant (KeyToCharStar (GetString (sym)), + symtree := BuildStringConstant (location, + KeyToCharStar (GetString (sym)), GetStringLength (sym)) END ; - PreAddModGcc(sym, symtree) ; - WatchRemoveList(sym, todolist) ; - WatchIncludeList(sym, fullydeclared) + PreAddModGcc (sym, symtree) ; + WatchRemoveList (sym, todolist) ; + WatchIncludeList (sym, fullydeclared) END DeclareStringConstant ; @@ -1614,21 +1559,20 @@ END DeclareStringConstant ; PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ; VAR - size: CARDINAL ; + size : CARDINAL ; location: location_t ; BEGIN - location := TokenToLocation(GetDeclaredMod(sym)) ; - DeclareConstant(tokenno, sym) ; - size := GetStringLength(sym) ; - IF size>1 + location := TokenToLocation (tokenno) ; + DeclareConstant (tokenno, sym) ; + size := GetStringLength (sym) ; + IF size > 1 THEN (* will be a string anyway *) - RETURN( Tree(Mod2Gcc(sym)) ) + RETURN Tree (Mod2Gcc (sym)) ELSE - RETURN( - BuildStringConstant(KeyToCharStar(GetString(sym)), - GetStringLength(sym)) - ) + RETURN BuildStringConstant (location, + KeyToCharStar (GetString (sym)), + GetStringLength (sym)) END END PromoteToString ; @@ -1706,19 +1650,17 @@ END TryDeclareConstructor ; PROCEDURE WalkConst (sym: CARDINAL; p: WalkAction) ; VAR type: CARDINAL ; - tok : CARDINAL ; BEGIN - Assert(IsConst(sym)) ; - type := GetSType(sym) ; - IF type#NulSym + Assert (IsConst (sym)) ; + type := GetSType (sym) ; + IF type # NulSym THEN - p(type) + p (type) END ; - IF IsConstSet(sym) OR IsConstructor(sym) + IF IsConstSet (sym) OR IsConstructor (sym) THEN - WalkConstructor(sym, p) - END ; - tok := GetDeclaredMod (sym) + WalkConstructor (sym, p) + END END WalkConst ; @@ -1871,7 +1813,7 @@ BEGIN THEN DeclareCharConstant(sym) ELSE - DeclareStringConstant(sym) + DeclareStringConstant (tokenno, sym) END ELSIF IsValueSolved(sym) THEN @@ -1930,7 +1872,7 @@ BEGIN THEN DeclareCharConstant(sym) ELSE - DeclareStringConstant(sym) + DeclareStringConstant (tokenno, sym) END ELSIF IsValueSolved(sym) THEN @@ -2007,7 +1949,7 @@ BEGIN oaf := GetOAFamily(sym) ; o := unboundedp ; unboundedp := p ; - ForeachOAFamily(oaf, WalkFamilyOfUnbounded) ; + ForeachOAFamily (oaf, WalkFamilyOfUnbounded) ; unboundedp := o END WalkAssociatedUnbounded ; @@ -2016,6 +1958,7 @@ END WalkAssociatedUnbounded ; WalkProcedureParameterDependants - *) +(* PROCEDURE WalkProcedureParameterDependants (sym: CARDINAL; p: WalkAction) ; VAR son, @@ -2040,6 +1983,7 @@ BEGIN END END END WalkProcedureParameterDependants ; +*) (* @@ -2599,7 +2543,7 @@ BEGIN WHILE ResolveConstantExpressions(DeclareConstFully, start, end) DO END ; (* we need to evaluate some constant expressions to resolve these types *) - IF DeclaredOutstandingTypes(FALSE, start, end) + IF DeclaredOutstandingTypes (FALSE) THEN END ; m := NoOfElementsInSet(ToDoList) @@ -2645,8 +2589,6 @@ END PushBinding ; *) PROCEDURE PopBinding (scope: CARDINAL) ; -VAR - t: Tree ; BEGIN scope := SkipModuleScope(scope) ; IF scope=NulSym @@ -2655,7 +2597,7 @@ BEGIN ELSE Assert(IsProcedure(scope)) ; finishFunctionDecl(TokenToLocation(GetDeclaredMod(scope)), Mod2Gcc(scope)) ; - t := popFunctionScope() + Assert (popFunctionScope () # NIL) END END PopBinding ; @@ -2688,14 +2630,12 @@ END DeclareTypesConstantsProcedures ; PROCEDURE AssertAllTypesDeclared (scope: CARDINAL) ; VAR - o, n, Var: CARDINAL ; failed: BOOLEAN ; BEGIN failed := FALSE ; n := 1 ; Var := GetNth(scope, n) ; - o := 0 ; WHILE Var#NulSym DO IF NOT AllDependantsFullyDeclared(GetSType(Var)) THEN @@ -3006,27 +2946,6 @@ BEGIN END DeclareBoolean ; -(* - DeclareFileName - declares the filename to the back end. -*) - -PROCEDURE DeclareFileName ; -VAR - ModuleName, - FileName : String ; -BEGIN - ModuleName := InitStringCharStar(KeyToCharStar(GetSymName(GetMainModule()))) ; - FileName := CalculateFileName(ModuleName, Mark(InitString('mod'))) ; - -(* --fixme-- - SetFileNameAndLineNo(string(FileName), 1) ; -*) - - ModuleName := KillString(ModuleName) ; - FileName := KillString(FileName) -END DeclareFileName ; - - (* DeclareFixedSizedType - declares the GNU Modula-2 fixed types (if the back end support such a type). @@ -3183,24 +3102,6 @@ BEGIN END DeclareDefaultConstants ; -(* - AlignDeclarationWithSource - given a symbol, sym, set the source file and line - number with the declaration position of sym. -*) - -PROCEDURE AlignDeclarationWithSource (sym: CARDINAL) ; -VAR - s: String ; - t: CARDINAL ; -BEGIN - t := GetDeclaredMod(sym) ; - s := FindFileNameFromToken(t, 0) ; -(* --fixme-- - SetFileNameAndLineNo(string(s), TokenToLineNo(t, 0)) -*) -END AlignDeclarationWithSource ; - - (* FindContext - returns the scope where the symbol should be created. @@ -3353,7 +3254,6 @@ VAR BEGIN IF NOT GccKnowsAbout (variable) THEN - AlignDeclarationWithSource (variable) ; scope := FindContext (ModSym) ; decl := FindOuterModule (variable) ; Assert (AllDependantsFullyDeclared (GetSType (variable))) ; @@ -3382,7 +3282,6 @@ VAR BEGIN IF NOT GccKnowsAbout(var) THEN - AlignDeclarationWithSource(var) ; scope := FindContext(mainModule) ; decl := FindOuterModule(var) ; Assert(AllDependantsFullyDeclared(GetSType(var))) ; @@ -3482,7 +3381,6 @@ END DeclareImportedVariablesWholeProgram ; PROCEDURE DeclareLocalVariable (var: CARDINAL) ; BEGIN - AlignDeclarationWithSource (var) ; Assert (AllDependantsFullyDeclared (var)) ; DoVariableDeclaration (var, KeyToCharStar (GetFullSymName (var)), @@ -3527,7 +3425,6 @@ BEGIN scope := Mod2Gcc (GetProcedureScope (sym)) ; Var := GetNth (sym, i) ; WHILE Var # NulSym DO - AlignDeclarationWithSource (Var) ; Assert (AllDependantsFullyDeclared (GetSType (Var))) ; DoVariableDeclaration (Var, KeyToCharStar (GetFullSymName (Var)), @@ -4305,21 +4202,18 @@ END CheckAlignment ; *) PROCEDURE CheckPragma (type: Tree; sym: CARDINAL) : Tree ; -VAR - align: CARDINAL ; BEGIN - align := GetAlignment(sym) ; - IF IsDeclaredPacked(sym) + IF IsDeclaredPacked (sym) THEN - IF IsRecordField(sym) OR IsFieldVarient(sym) + IF IsRecordField (sym) OR IsFieldVarient (sym) THEN - type := SetDeclPacked(type) - ELSIF IsRecord(sym) OR IsVarient(sym) + type := SetDeclPacked (type) + ELSIF IsRecord (sym) OR IsVarient (sym) THEN - type := SetTypePacked(type) + type := SetTypePacked (type) END END ; - RETURN( CheckAlignment(type, sym) ) + RETURN CheckAlignment (type, sym) END CheckPragma ; @@ -4465,12 +4359,13 @@ VAR enumlist: Tree ; BEGIN (* add relationship between gccSym and sym *) - type := GetSType(sym) ; - equiv := GetPackedEquivalent(type) ; - enumlist := GetEnumList(equiv) ; - PushValue(sym) ; - field := DeclareFieldValue(sym, PopIntegerTree(), enumlist) ; - PutEnumList(equiv, enumlist) + type := GetSType (sym) ; + equiv := GetPackedEquivalent (type) ; + enumlist := GetEnumList (equiv) ; + PushValue (sym) ; + field := DeclareFieldValue (sym, PopIntegerTree(), enumlist) ; + Assert (field # NIL) ; + PutEnumList (equiv, enumlist) END DeclarePackedFieldEnumeration ; @@ -5675,6 +5570,7 @@ END WalkRecordFieldDependants ; WalkVarient - *) +(* PROCEDURE WalkVarient (sym: CARDINAL; p: WalkAction) ; VAR v : CARDINAL ; @@ -5694,6 +5590,7 @@ BEGIN p(align) END END WalkVarient ; +*) (* @@ -6230,7 +6127,6 @@ END ConstantKnownAndUsed ; PROCEDURE InitDeclarations ; BEGIN - DeclareFileName ; DeclareDefaultTypes ; DeclareDefaultConstants END InitDeclarations ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index b917bc03891..b71d37a26ab 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -677,41 +677,43 @@ END FindType ; BuildTreeFromInterface - generates a GCC tree from an interface definition. *) -PROCEDURE BuildTreeFromInterface (sym: CARDINAL) : Tree ; +PROCEDURE BuildTreeFromInterface (tokenno: CARDINAL; sym: CARDINAL) : Tree ; VAR - i : CARDINAL ; - name : Name ; + i : CARDINAL ; + name : Name ; str, - obj : CARDINAL ; + obj : CARDINAL ; gccName, - tree : Tree ; + tree : Tree ; + location: location_t; BEGIN - tree := Tree(NIL) ; + tree := Tree (NIL) ; IF sym#NulSym THEN + location := TokenToLocation (tokenno) ; i := 1 ; REPEAT - GetRegInterface(sym, i, name, str, obj) ; + GetRegInterface (sym, i, name, str, obj) ; IF str#NulSym THEN - IF IsConstString(str) + IF IsConstString (str) THEN - DeclareConstant(GetDeclaredMod(obj), obj) ; - IF name=NulName + DeclareConstant (tokenno, obj) ; + IF name = NulName THEN gccName := NIL ELSE - gccName := BuildStringConstant(KeyToCharStar(name), LengthKey(name)) + gccName := BuildStringConstant (location, KeyToCharStar (name), LengthKey (name)) END ; - tree := ChainOnParamValue(tree, gccName, PromoteToString(GetDeclaredMod(str), str), Mod2Gcc(obj)) + tree := ChainOnParamValue (tree, gccName, PromoteToString (tokenno, str), Mod2Gcc (obj)) ELSE - WriteFormat0('a constraint to the GNU ASM statement must be a constant string') + WriteFormat0 ('a constraint to the GNU ASM statement must be a constant string') END END ; INC(i) - UNTIL (str=NulSym) AND (obj=NulSym) ; + UNTIL (str = NulSym) AND (obj = NulSym) ; END ; - RETURN( tree ) + RETURN tree END BuildTreeFromInterface ; @@ -777,8 +779,8 @@ BEGIN can handle the register dependency providing the user specifies VOLATILE and input/output/trash sets correctly. *) - inputs := BuildTreeFromInterface (GetGnuAsmInput(GnuAsm)) ; - outputs := BuildTreeFromInterface (GetGnuAsmOutput(GnuAsm)) ; + inputs := BuildTreeFromInterface (tokenno, GetGnuAsmInput(GnuAsm)) ; + outputs := BuildTreeFromInterface (tokenno, GetGnuAsmOutput(GnuAsm)) ; trash := BuildTrashTreeFromInterface (GetGnuAsmTrash(GnuAsm)) ; labels := NIL ; (* at present it makes no sence for Modula-2 to jump to a label, given that labels are not allowed in Modula-2. *) @@ -2634,7 +2636,7 @@ BEGIN DeclareConstructor (CurrentQuadToken, quad, op3) ; IF (IsConst (op3) AND (type=Char)) OR IsConstString (op3) THEN - value := BuildStringConstant (KeyToCharStar (GetString (op3)), GetStringLength (op3)) + value := BuildStringConstant (location, KeyToCharStar (GetString (op3)), GetStringLength (op3)) ELSE value := Mod2Gcc (op3) END ; @@ -2945,17 +2947,17 @@ BEGIN str := 'abcde' but not ch := 'a' *) - IF GetType(op3)=Char + IF GetType (op3) = Char THEN (* * create string from char and add nul to the end, nul is * added by BuildStringConstant *) - op3t := BuildStringConstant(KeyToCharStar(GetString(op3)), 1) + op3t := BuildStringConstant (location, KeyToCharStar (GetString (op3)), 1) ELSE - op3t := Mod2Gcc(op3) + op3t := Mod2Gcc (op3) END ; - op3t := ConvertString(Mod2Gcc(op1t), op3t) ; + op3t := ConvertString (Mod2Gcc (op1t), op3t) ; PushIntegerTree(FindSize(tokenno, op3)) ; PushIntegerTree(FindSize(tokenno, op1t)) ; diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod index 1e10fe67a53..ca0ef37fdb6 100644 --- a/gcc/m2/gm2-compiler/M2MetaError.mod +++ b/gcc/m2/gm2-compiler/M2MetaError.mod @@ -488,6 +488,7 @@ END killErrorBlock ; PROCEDURE InternalFormat (eb: errorBlock; m: ARRAY OF CHAR; line: CARDINAL) ; BEGIN + printf1 ("M2MetaError.mod:%d:internalformat error detected\n", line) ; dump (eb) ; InternalError (m) END InternalFormat ; @@ -707,11 +708,13 @@ END OutGlyphS ; OutColorS - outputs a string of color requests. *) +(* PROCEDURE OutColorS (VAR eb: errorBlock; s: String) ; BEGIN flushColor (eb) ; eb.out := ConCat (eb.out, s) END OutColorS ; +*) (* @@ -828,7 +831,7 @@ END doSkipType ; PROCEDURE doGetType (VAR eb: errorBlock; VAR sym: ARRAY OF CARDINAL; bol: CARDINAL) ; BEGIN - IF (NOT empty (eb)) OR (sym[bol] = NulSym) + IF (bol > HIGH (sym)) OR (NOT empty (eb)) OR (sym[bol] = NulSym) THEN RETURN ELSE @@ -846,7 +849,7 @@ PROCEDURE doGetSkipType (VAR eb: errorBlock; VAR sym: ARRAY OF CARDINAL; bol: CA VAR prev: CARDINAL ; BEGIN - IF (NOT empty (eb)) OR (sym[bol] = NulSym) + IF (bol > HIGH (sym)) OR (NOT empty (eb)) OR (sym[bol] = NulSym) THEN RETURN ELSE @@ -997,6 +1000,7 @@ END used ; ConCatWord - joins sentances, a, b, together. *) +(* PROCEDURE ConCatWord (a, b: String) : String ; BEGIN IF (Length (a) = 1) AND (char(a, 0) = 'a') @@ -1012,6 +1016,7 @@ BEGIN END ; RETURN x (a, ConCat(a, b)) END ConCatWord ; +*) (* @@ -1124,6 +1129,7 @@ END doDesc ; copySym - copies, n+1, symbols, from, ->, to. *) +(* PROCEDURE copySym (from: ARRAY OF CARDINAL; VAR to: ARRAY OF CARDINAL; n: CARDINAL) ; VAR i: CARDINAL ; @@ -1139,6 +1145,7 @@ BEGIN END END END copySym ; +*) (* diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 9560ca1b33e..8c1fac13273 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -233,8 +233,8 @@ FROM M2Range IMPORT InitAssignmentRangeCheck, InitWholeZeroDivisionCheck, InitWholeZeroRemainderCheck, InitParameterRangeCheck, - CheckRangeAddVariableRead, - CheckRangeRemoveVariableRead, + (* CheckRangeAddVariableRead, *) + (* CheckRangeRemoveVariableRead, *) WriteRangeCheck ; FROM M2CaseList IMPORT PushCase, PopCase, AddRange, BeginCaseList, EndCaseList, ElseCase ; diff --git a/gcc/m2/gm2-compiler/M2Range.def b/gcc/m2/gm2-compiler/M2Range.def index 9afdc7c2722..bc9a674b3b6 100644 --- a/gcc/m2/gm2-compiler/M2Range.def +++ b/gcc/m2/gm2-compiler/M2Range.def @@ -70,8 +70,8 @@ EXPORT QUALIFIED InitAssignmentRangeCheck, InitWholeZeroDivisionCheck, InitWholeZeroRemainderCheck, CodeRangeCheck, FoldRangeCheck, CodeErrorCheck, - CheckRangeAddVariableRead, - CheckRangeRemoveVariableRead, + (* CheckRangeAddVariableRead, *) + (* CheckRangeRemoveVariableRead, *) WriteRangeCheck, OverlapsRange, IsEqual, IsGreaterOrEqual, IsGreater, @@ -344,7 +344,7 @@ PROCEDURE CodeErrorCheck (r: CARDINAL; function, message: String) : Tree ; symbol table. *) -PROCEDURE CheckRangeAddVariableRead (r: CARDINAL; quadNo: CARDINAL) ; +(* PROCEDURE CheckRangeAddVariableRead (r: CARDINAL; quadNo: CARDINAL) ; *) (* @@ -353,7 +353,7 @@ PROCEDURE CheckRangeAddVariableRead (r: CARDINAL; quadNo: CARDINAL) ; the symbol table. *) -PROCEDURE CheckRangeRemoveVariableRead (r: CARDINAL; quadNo: CARDINAL) ; +(* PROCEDURE CheckRangeRemoveVariableRead (r: CARDINAL; quadNo: CARDINAL) ; *) (* diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod index 344d0b7d9f1..1e3a6402f15 100644 --- a/gcc/m2/gm2-compiler/M2Range.mod +++ b/gcc/m2/gm2-compiler/M2Range.mod @@ -514,11 +514,10 @@ END PutRangeArraySubscript ; PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (tokno, GetIndice (RangeIndex, r), assignment, d, e) ; + Assert (PutRange (tokno, GetIndice (RangeIndex, r), assignment, d, e) # NIL) ; RETURN r END InitAssignmentRangeCheck ; @@ -532,11 +531,10 @@ END InitAssignmentRangeCheck ; PROCEDURE InitReturnRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (tokno, GetIndice (RangeIndex, r), returnassignment, d, e) ; + Assert (PutRange (tokno, GetIndice (RangeIndex, r), returnassignment, d, e) # NIL) ; RETURN r END InitReturnRangeCheck ; @@ -550,11 +548,10 @@ END InitReturnRangeCheck ; PROCEDURE InitSubrangeRangeCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (GetTokenNo (), GetIndice (RangeIndex, r), subrangeassignment, d, e) ; + Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), subrangeassignment, d, e) # NIL) ; RETURN r END InitSubrangeRangeCheck ; @@ -568,11 +565,10 @@ END InitSubrangeRangeCheck ; PROCEDURE InitStaticArraySubscriptRangeCheck (d, e, dim: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeArraySubscript (GetIndice (RangeIndex, r), staticarraysubscript, d, e, dim) ; + Assert (PutRangeArraySubscript (GetIndice (RangeIndex, r), staticarraysubscript, d, e, dim) # NIL) ; RETURN r END InitStaticArraySubscriptRangeCheck ; @@ -586,11 +582,10 @@ END InitStaticArraySubscriptRangeCheck ; PROCEDURE InitDynamicArraySubscriptRangeCheck (d, e, dim: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeArraySubscript (GetIndice (RangeIndex, r), dynamicarraysubscript, d, e, dim) ; + Assert (PutRangeArraySubscript (GetIndice (RangeIndex, r), dynamicarraysubscript, d, e, dim) # NIL) ; RETURN r END InitDynamicArraySubscriptRangeCheck ; @@ -604,11 +599,10 @@ END InitDynamicArraySubscriptRangeCheck ; PROCEDURE InitIncRangeCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (GetTokenNo (), GetIndice (RangeIndex, r), inc, d, e) ; + Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), inc, d, e) # NIL) ; RETURN r END InitIncRangeCheck ; @@ -622,11 +616,10 @@ END InitIncRangeCheck ; PROCEDURE InitDecRangeCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (GetTokenNo (), GetIndice (RangeIndex, r), dec, d, e) ; + Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), dec, d, e) # NIL) ; RETURN r END InitDecRangeCheck ; @@ -638,11 +631,10 @@ END InitDecRangeCheck ; PROCEDURE InitInclCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), incl, d, e) ; + Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), incl, d, e) # NIL) ; RETURN r END InitInclCheck ; @@ -654,11 +646,10 @@ END InitInclCheck ; PROCEDURE InitExclCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), excl, d, e) ; + Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), excl, d, e) # NIL) ; RETURN r END InitExclCheck ; @@ -670,11 +661,10 @@ END InitExclCheck ; PROCEDURE InitShiftCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), shift, d, e) ; + Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), shift, d, e) # NIL) ; RETURN r END InitShiftCheck ; @@ -686,11 +676,10 @@ END InitShiftCheck ; PROCEDURE InitRotateCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), rotate, d, e) ; + Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), rotate, d, e) # NIL) ; RETURN r END InitRotateCheck ; @@ -702,11 +691,10 @@ END InitRotateCheck ; PROCEDURE InitTypesAssignmentCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeassign, d, e) ; + Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeassign, d, e) # NIL) ; RETURN r END InitTypesAssignmentCheck ; @@ -719,11 +707,10 @@ END InitTypesAssignmentCheck ; PROCEDURE InitTypesParameterCheck (proc: CARDINAL; i: CARDINAL; formal, actual: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeParam (GetIndice (RangeIndex, r), typeparam, proc, i, formal, actual) ; + Assert (PutRangeParam (GetIndice (RangeIndex, r), typeparam, proc, i, formal, actual) # NIL) ; RETURN r END InitTypesParameterCheck ; @@ -762,11 +749,10 @@ END PutRangeParamAssign ; PROCEDURE InitParameterRangeCheck (proc: CARDINAL; i: CARDINAL; formal, actual: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeParamAssign (GetIndice (RangeIndex, r), paramassign, proc, i, formal, actual) ; + Assert (PutRangeParamAssign (GetIndice (RangeIndex, r), paramassign, proc, i, formal, actual) # NIL) ; RETURN r END InitParameterRangeCheck ; @@ -778,11 +764,10 @@ END InitParameterRangeCheck ; PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange() ; - p := PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeexpr, d, e) ; + Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeexpr, d, e) # NIL) ; RETURN r END InitTypesExpressionCheck ; @@ -796,11 +781,10 @@ END InitTypesExpressionCheck ; PROCEDURE InitForLoopBeginRangeCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopbegin, d, e) ; + Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopbegin, d, e) # NIL) ; RETURN r END InitForLoopBeginRangeCheck ; @@ -814,11 +798,10 @@ END InitForLoopBeginRangeCheck ; PROCEDURE InitForLoopToRangeCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopto, d, e) ; + Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopto, d, e) # NIL) ; RETURN r END InitForLoopToRangeCheck ; @@ -833,11 +816,10 @@ END InitForLoopToRangeCheck ; PROCEDURE InitForLoopEndRangeCheck (d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopend, d, e) ; + Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopend, d, e) # NIL) ; RETURN r END InitForLoopEndRangeCheck ; @@ -849,11 +831,10 @@ END InitForLoopEndRangeCheck ; PROCEDURE InitPointerRangeCheck (tokno: CARDINAL; d: CARDINAL; isLeft: BOOLEAN) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangePointer (tokno, GetIndice (RangeIndex, r), d, isLeft) ; + Assert (PutRangePointer (tokno, GetIndice (RangeIndex, r), d, isLeft) # NIL) ; RETURN r END InitPointerRangeCheck ; @@ -866,11 +847,10 @@ END InitPointerRangeCheck ; PROCEDURE InitNoReturnRangeCheck () : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoEval (GetIndice(RangeIndex, r), noreturn) ; + Assert (PutRangeNoEval (GetIndice(RangeIndex, r), noreturn) # NIL) ; RETURN r END InitNoReturnRangeCheck ; @@ -884,11 +864,10 @@ END InitNoReturnRangeCheck ; PROCEDURE InitNoElseRangeCheck () : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeNoEval (GetIndice (RangeIndex, r), noelse) ; + Assert (PutRangeNoEval (GetIndice (RangeIndex, r), noelse) # NIL) ; RETURN r END InitNoElseRangeCheck ; @@ -900,11 +879,10 @@ END InitNoElseRangeCheck ; PROCEDURE InitWholeNonPosDivCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholenonposdiv, d, e) ; + Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholenonposdiv, d, e) # NIL) ; RETURN r END InitWholeNonPosDivCheck ; @@ -916,11 +894,10 @@ END InitWholeNonPosDivCheck ; PROCEDURE InitWholeNonPosModCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholenonposmod, d, e) ; + Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholenonposmod, d, e) # NIL) ; RETURN r END InitWholeNonPosModCheck ; @@ -932,11 +909,10 @@ END InitWholeNonPosModCheck ; PROCEDURE InitWholeZeroDivisionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholezerodiv, d, e) ; + Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholezerodiv, d, e) # NIL) ; RETURN r END InitWholeZeroDivisionCheck ; @@ -948,11 +924,10 @@ END InitWholeZeroDivisionCheck ; PROCEDURE InitWholeZeroRemainderCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; VAR - p: Range ; r: CARDINAL ; BEGIN r := InitRange () ; - p := PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholezerorem, d, e) ; + Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholezerorem, d, e) # NIL) ; RETURN r END InitWholeZeroRemainderCheck ; @@ -1607,7 +1582,7 @@ END FoldTypeAssign ; FoldTypeParam - *) -PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL; r: CARDINAL) ; +PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL) ; BEGIN IF ParameterTypeCompatible (tokenNo, '{%4EN} type failure between actual {%3ad} and the {%2ad}', @@ -1695,7 +1670,7 @@ END CodeTypeAssign ; CodeTypeParam - *) -PROCEDURE CodeTypeParam (tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL; r: CARDINAL) ; +PROCEDURE CodeTypeParam (tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL) ; BEGIN IF NOT ParameterTypeCompatible (tokenNo, '{%4EN} type failure between actual {%3ad} and the formal {%2ad}', @@ -1760,7 +1735,7 @@ BEGIN CASE type OF typeassign: FoldTypeAssign(q, tokenNo, des, expr, r) | - typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo, r) | + typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo) | typeexpr: FoldTypeExpr(q, tokenNo, des, expr, r) ELSE @@ -1793,7 +1768,7 @@ BEGIN CASE type OF typeassign: CodeTypeAssign(tokenNo, des, expr, r) | - typeparam: CodeTypeParam(tokenNo, des, expr, procedure, paramNo, r) | + typeparam: CodeTypeParam(tokenNo, des, expr, procedure, paramNo) | typeexpr: CodeTypeExpr(tokenNo, des, expr, r) ELSE @@ -1978,9 +1953,9 @@ END FoldCaseBounds ; during the code generation of this function. *) -PROCEDURE CodeCaseBounds (tokenno: CARDINAL; caseList: CARDINAL; function, message: String) ; +PROCEDURE CodeCaseBounds (tokenno: CARDINAL; caseList: CARDINAL) ; BEGIN - IF CaseBoundsResolved(tokenno, caseList) + IF CaseBoundsResolved (tokenno, caseList) THEN IF TypeCaseBounds (caseList) THEN @@ -1990,25 +1965,25 @@ BEGIN THEN (* nothing to do *) END ; - IF MissingCaseBounds(tokenno, caseList) + IF MissingCaseBounds (tokenno, caseList) THEN (* nothing to do *) END ELSE - MetaErrorT0(tokenno, '{%E}the CASE statement ranges must be constants') + MetaErrorT0 (tokenno, '{%E}the CASE statement ranges must be constants') END END CodeCaseBounds ; (* - MakeAndDeclareConstLit - + MakeAndDeclareConstLit - creates a constant of value and declares it to GCC. *) -PROCEDURE MakeAndDeclareConstLit (tokenno: CARDINAL; n: Name; type: CARDINAL) : CARDINAL ; +PROCEDURE MakeAndDeclareConstLit (tokenno: CARDINAL; value: Name; type: CARDINAL) : CARDINAL ; VAR constant: CARDINAL ; BEGIN - constant := MakeConstLit (tokenno, MakeKey('0'), ZType) ; + constant := MakeConstLit (tokenno, value, type) ; TryDeclareConstant (tokenno, constant) ; (* use quad tokenno, rather than the range tokenNo *) Assert (GccKnowsAbout (constant)) ; RETURN constant @@ -2029,13 +2004,13 @@ BEGIN TryDeclareConstant(tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *) IF GccKnowsAbout(expr) AND IsConst(expr) THEN - zero := MakeAndDeclareConstLit(tokenno, MakeKey('0'), ZType) ; - IF IsGreaterOrEqualConversion(TokenToLocation(tokenno), zero, des, expr) + zero := MakeAndDeclareConstLit (tokenno, MakeKey ('0'), ZType) ; + IF IsGreaterOrEqualConversion (TokenToLocation (tokenno), zero, des, expr) THEN - MetaErrorT2(tokenNo, - 'the divisor {%2Wa} in this division expression is less than or equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}', - des, expr) ; - PutQuad(q, ErrorOp, NulSym, NulSym, r) + MetaErrorT2 (tokenNo, + 'the divisor {%2Wa} in this division expression is less than or equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}', + des, expr) ; + PutQuad (q, ErrorOp, NulSym, NulSym, r) END END END @@ -2056,13 +2031,13 @@ BEGIN TryDeclareConstant(tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *) IF GccKnowsAbout(expr) AND IsConst(expr) THEN - zero := MakeAndDeclareConstLit(tokenno, MakeKey('0'), ZType) ; - IF IsGreaterOrEqualConversion(TokenToLocation(tokenno), zero, des, expr) + zero := MakeAndDeclareConstLit (tokenno, MakeKey('0'), ZType) ; + IF IsGreaterOrEqualConversion (TokenToLocation(tokenno), zero, des, expr) THEN - MetaErrorT2(tokenNo, - 'the divisor {%2Wa} in this modulus expression is less than or equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}', - des, expr) ; - PutQuad(q, ErrorOp, NulSym, NulSym, r) + MetaErrorT2 (tokenNo, + 'the divisor {%2Wa} in this modulus expression is less than or equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}', + des, expr) ; + PutQuad (q, ErrorOp, NulSym, NulSym, r) END END END @@ -2083,13 +2058,13 @@ BEGIN TryDeclareConstant(tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *) IF GccKnowsAbout(expr) AND IsConst(expr) THEN - zero := MakeAndDeclareConstLit(tokenno, MakeKey('0'), ZType) ; - IF IsEqualConversion(zero, des, expr) + zero := MakeAndDeclareConstLit (tokenno, MakeKey ('0'), ZType) ; + IF IsEqualConversion (zero, des, expr) THEN - MetaErrorT2(tokenNo, + MetaErrorT2 (tokenNo, 'the divisor {%2Wa} in this division expression is equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}', - des, expr) ; - PutQuad(q, ErrorOp, NulSym, NulSym, r) + des, expr) ; + PutQuad (q, ErrorOp, NulSym, NulSym, r) END END END @@ -2110,13 +2085,13 @@ BEGIN TryDeclareConstant(tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *) IF GccKnowsAbout(expr) AND IsConst(expr) THEN - zero := MakeAndDeclareConstLit(tokenno, MakeKey('0'), ZType) ; - IF IsEqualConversion(zero, des, expr) + zero := MakeAndDeclareConstLit (tokenno, MakeKey ('0'), ZType) ; + IF IsEqualConversion (zero, des, expr) THEN - MetaErrorT2(tokenNo, + MetaErrorT2 (tokenNo, 'the divisor {%2Wa} in this remainder expression is equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}', - des, expr) ; - PutQuad(q, ErrorOp, NulSym, NulSym, r) + des, expr) ; + PutQuad (q, ErrorOp, NulSym, NulSym, r) END END END @@ -2215,10 +2190,10 @@ END BuildStringParam ; PROCEDURE BuildStringParamLoc (location: location_t; s: String) ; BEGIN - BuildParam(location, - BuildConvert(location, Mod2Gcc(Address), - BuildAddr(location, BuildStringConstant(string(s), Length(s)), - FALSE), FALSE)) + BuildParam (location, + BuildConvert (location, Mod2Gcc (Address), + BuildAddr (location, BuildStringConstant (location, string(s), Length(s)), + FALSE), FALSE)) END BuildStringParamLoc ; @@ -2720,7 +2695,7 @@ PROCEDURE CodeInclExcl (tokenno: CARDINAL; r: CARDINAL; function, message: String) ; VAR p : Range ; - t, e, + e, desMin, desMax: Tree ; location : location_t ; BEGIN @@ -2957,7 +2932,7 @@ END CodeForLoopTo ; *) PROCEDURE SameTypesCodeForLoopEnd (tokenNo: CARDINAL; r: CARDINAL; function, message: String; - p: Range; dmin, dmax, emin, emax: Tree) ; + p: Range; dmax: Tree) ; VAR inc, room, @@ -2982,7 +2957,7 @@ END SameTypesCodeForLoopEnd ; *) PROCEDURE DiffTypesCodeForLoopEnd (tokenNo: CARDINAL; r: CARDINAL; function, message: String; - p: Range; dmin, dmax, emin, emax: Tree) ; + p: Range; dmax, emin, emax: Tree) ; VAR location : location_t ; desoftypee, @@ -3086,9 +3061,9 @@ BEGIN isCard := GreEqu(tokenno) ; IF (desLowestType=exprLowestType) AND isCard THEN - SameTypesCodeForLoopEnd(tokenno, r, function, message, p, dmin, dmax, emin, emax) + SameTypesCodeForLoopEnd(tokenno, r, function, message, p, dmax) ELSE - DiffTypesCodeForLoopEnd(tokenno, r, function, message, p, dmin, dmax, emin, emax) + DiffTypesCodeForLoopEnd(tokenno, r, function, message, p, dmax, emin, emax) END END END @@ -3100,8 +3075,7 @@ END CodeForLoopEnd ; CodeNil - *) -PROCEDURE CodeNil (tokenno: CARDINAL; - r: CARDINAL; function, message: String) ; +PROCEDURE CodeNil (r: CARDINAL; function, message: String) ; VAR p : Range ; condition, t: Tree ; @@ -3141,14 +3115,14 @@ VAR BEGIN p := GetIndice(RangeIndex, r) ; WITH p^ DO - TryDeclareConstant(tokenNo, expr) ; - IF GccKnowsAbout(expr) + TryDeclareConstant (tokenNo, expr) ; + IF GccKnowsAbout (expr) THEN - location := TokenToLocation(tokenno) ; - e := ZConstToTypedConst(LValueToGenericPtr(location, expr), expr, des) ; - zero := MakeAndDeclareConstLit(tokenno, MakeKey('0'), SkipType(GetType(des))) ; - condition := BuildLessThanOrEqual(location, e, Mod2Gcc(zero)) ; - AddStatement(location, BuildIfThenDoEnd(condition, CodeErrorCheck(r, function, message))) + location := TokenToLocation (tokenno) ; + e := ZConstToTypedConst (LValueToGenericPtr(location, expr), expr, des) ; + zero := MakeAndDeclareConstLit (tokenno, MakeKey('0'), ZType) ; + condition := BuildLessThanOrEqual (location, e, Mod2Gcc (zero)) ; + AddStatement (location, BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message))) ELSE InternalError ('should have resolved expr') END @@ -3176,7 +3150,7 @@ BEGIN THEN location := TokenToLocation(tokenno) ; e := ZConstToTypedConst(LValueToGenericPtr(location, expr), expr, des) ; - zero := MakeAndDeclareConstLit(tokenno, MakeKey('0'), ZType) ; + zero := MakeAndDeclareConstLit (tokenno, MakeKey('0'), ZType) ; condition := BuildEqualTo(location, e, BuildConvert(location, GetTreeType(e), Mod2Gcc(zero), FALSE)) ; AddStatement(location, BuildIfThenDoEnd(condition, CodeErrorCheck(r, function, message))) @@ -3338,10 +3312,10 @@ BEGIN forloopbegin : CodeForLoopBegin (tokenNo, r, function, message) | forloopto : CodeForLoopTo (tokenNo, r, function, message) | forloopend : CodeForLoopEnd (tokenNo, r, function, message) | - pointernil : CodeNil (tokenNo, r, function, message) | + pointernil : CodeNil (r, function, message) | noreturn : AddStatement (TokenToLocation (tokenNo), CodeErrorCheck (r, function, message)) | noelse : AddStatement (TokenToLocation (tokenNo), CodeErrorCheck (r, function, message)) | - casebounds : CodeCaseBounds (tokenNo, caseList, function, message) | + casebounds : CodeCaseBounds (tokenNo, caseList) | wholenonposdiv : CodeWholeNonPos (tokenNo, r, function, message) | wholenonposmod : CodeWholeNonPos (tokenNo, r, function, message) | wholezerodiv : CodeWholeZero (tokenNo, r, function, message) | @@ -3362,7 +3336,7 @@ END CodeRangeCheck ; then adds this quadruple to the variable list. *) - +(* PROCEDURE AddVarRead (sym: CARDINAL; quadNo: CARDINAL) ; BEGIN IF (sym#NulSym) AND IsVar(sym) @@ -3370,6 +3344,7 @@ BEGIN PutReadQuad(sym, GetMode(sym), quadNo) END END AddVarRead ; +*) (* @@ -3379,6 +3354,7 @@ END AddVarRead ; variable list. *) +(* PROCEDURE SubVarRead (sym: CARDINAL; quadNo: CARDINAL) ; BEGIN IF (sym#NulSym) AND IsVar(sym) @@ -3386,6 +3362,7 @@ BEGIN RemoveReadQuad(sym, GetMode(sym), quadNo) END END SubVarRead ; +*) (* @@ -3395,6 +3372,7 @@ END SubVarRead ; symbol table. *) +(* PROCEDURE CheckRangeAddVariableRead (r: CARDINAL; quadNo: CARDINAL) ; VAR p: Range ; @@ -3405,6 +3383,7 @@ BEGIN (* AddVarRead(expr, quadNo) *) END END CheckRangeAddVariableRead ; +*) (* @@ -3413,6 +3392,7 @@ END CheckRangeAddVariableRead ; the symbol table. *) +(* PROCEDURE CheckRangeRemoveVariableRead (r: CARDINAL; quadNo: CARDINAL) ; VAR p: Range ; @@ -3423,6 +3403,7 @@ BEGIN (* SubVarRead(expr, quadNo) *) END END CheckRangeRemoveVariableRead ; +*) (* diff --git a/gcc/m2/gm2-gcc/m2decl.c b/gcc/m2/gm2-gcc/m2decl.c index 9be7c90a2e1..038349d533d 100644 --- a/gcc/m2/gm2-gcc/m2decl.c +++ b/gcc/m2/gm2-gcc/m2decl.c @@ -301,7 +301,7 @@ m2decl_BuildCStringConstant (const char *string, int length) and, length. */ tree -m2decl_BuildStringConstant (const char *string, int length) +m2decl_BuildStringConstant (location_t location, const char *string, int length) { tree elem, index, type; @@ -309,6 +309,7 @@ m2decl_BuildStringConstant (const char *string, int length) index = build_index_type (build_int_cst (integer_type_node, length)); type = build_array_type (elem, index); return m2decl_BuildStringConstantType (length, string, type); + // maybe_wrap_with_location } /* BuildIntegerConstant - return a tree containing the integer value. */ diff --git a/gcc/m2/gm2-gcc/m2decl.def b/gcc/m2/gm2-gcc/m2decl.def index 382101c20d0..6d661be2b84 100644 --- a/gcc/m2/gm2-gcc/m2decl.def +++ b/gcc/m2/gm2-gcc/m2decl.def @@ -153,7 +153,7 @@ PROCEDURE BuildConstLiteralNumber (str: ADDRESS; base: CARDINAL) : Tree ; and, length. *) -PROCEDURE BuildStringConstant (string: ADDRESS; length: INTEGER) : Tree ; +PROCEDURE BuildStringConstant (location: location_t; string: ADDRESS; length: INTEGER) : Tree ; (* diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h index 5e439f7407f..a3c51c46bf1 100644 --- a/gcc/m2/gm2-gcc/m2decl.h +++ b/gcc/m2/gm2-gcc/m2decl.h @@ -37,7 +37,7 @@ along with GNU Modula-2; see the file COPYING3. If not see #endif /* !m2decl_c. */ EXTERN tree m2decl_GetDeclContext (tree t); -EXTERN tree m2decl_BuildStringConstant (const char *string, int length); +EXTERN tree m2decl_BuildStringConstant (location_t location, const char *string, int length); EXTERN tree m2decl_BuildCStringConstant (const char *string, int length); EXTERN tree m2decl_BuildConstLiteralNumber (const char *str, unsigned int base);
reply other threads:[~2021-10-11 19:14 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20211011191437.413FE3858D35@sourceware.org \ --to=gaius@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).