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] Remove unused variables, parameters and procedures.
Date: Thu, 26 Aug 2021 19:16:18 +0000 (GMT) [thread overview]
Message-ID: <20210826191618.43F983858D3C@sourceware.org> (raw)
https://gcc.gnu.org/g:f9d489dbbe77ac6c074ec7ed3d74b2fa1727770c
commit f9d489dbbe77ac6c074ec7ed3d74b2fa1727770c
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date: Thu Aug 26 20:15:19 2021 +0100
Remove unused variables, parameters and procedures.
2021-08-26 Gaius Mulley <gaius.mulley@southwales.ac.uk>
gcc/m2/
* gcc/m2/Make-lang.in (cflex.def): Removed from
GM2-COMP-BOOT-DEFS. (cflex.mod) Removed from
GM2-COMP-BOOT-MODS.
* gcc/m2/gm2-compiler/CLexBuf.mod (GetToken):
Remove unused local variable a. Use AdvanceToken
instead of GetToken. (AddTokToList) Remove unused variable b.
(IsLastTokenEof) Remove unused variable t.
* gcc/m2/gm2-compiler/M2ALU.mod (Reduce): New procedure.
(PrintValue) Use Reduce rather than PopIntegerTree.
* gcc/m2/gm2-compiler/M2Base.mod (Param): Remove unused
global variable. (IsVarientSame) Initialize ga at the procedure
start. Initialize gb at the procedure start.
* gcc/m2/gm2-compiler/M2CaseList.def (CaseBoundsResolved) tokenno
parameter removed.
* gcc/m2/gm2-compiler/M2CaseList.mod (RangePair) Data type
simplified. (ConflictingPair) Data type simplified. (CaseList)
Data type simplified. (SetRange) Data type simplified.
(Overlaps) Reformatted. (OverlappingCaseBound) Remove tokenno
parameter.
* gcc/m2/gm2-compiler/M2GenGCC.mod: (ConvertForComparison)
Commented out. (IsWord) Removed. (HaveDifferentTypes) Removed.
(FoldSetLogicalDifference) Commented out. (DetermineFieldOf)
Commented out. (CodeMath) Commented out.
* gcc/m2/gm2-compiler/M2Range.mod (FoldCaseBounds) remove
first parameter to TypeCaseBounds. (CodeCaseBounds) remove
first parameter to TypeCaseBounds.
* gcc/m2/gm2-compiler/M2Search.mod (Assert) Imported.
(GarbageDebugging) Declared. (doDSdbEnter) Commented out.
(doDSdbExit) Commented out. (DSdbEnter) Commented out.
(DSdbExit) Commented out. (DSdbExit) Assert s # NIL.
* gcc/m2/gm2-compiler/M2Swig.mod (Doresolveorder) Remove
parameter main. (DetermineParameter) Remove annotate parameter.
* gcc/m2/gm2-compiler/ObjectFiles.mod (RegisterModuleObject)
Remove local variable r as libc.close and libc.read procedure
functions have an optional return result. (IsRegistered)
Remove local variable r as libc.close and libc.read procedure
functions have an optional return result.
* gcc/m2/gm2-compiler/PCSymBuild.mod (WalkConst): Commented out.
* gcc/m2/gm2-compiler/Sets.mod (checkRange): Remove unused
variable a. Use Assert to check memset and memcpy results instead
of assigning to a. (DuplicateSet): Remove unused variable a.
Use Assert to check return value of memset and memcpy instead of
assigning to a.
* gcc/m2/gm2-compiler/SymbolTable.mod (MetaErrorT2): Imported.
(AlreadyImportedError) Commented out. (DisplayScopes) Commented
out. (GetConstFromTypeTree) Commented out.
(PutConstIntoTypeTree) Commented out. (SkipHiddenType) Commented
out. (GetLastMainScopeId) Commented out.
(PutExportUnImplemented) Commented out. (DumpSymbols) Commented out.
* gcc/m2/gm2-compiler/cflex.def (AdvanceToken): New procedure.
* gcc/m2/gm2-libs-min/libc.c (abort): Add infinite loop.
(exit): Add infinite loop.
* gcc/m2/gm2-libs/libc.def (read): define return value as
optional. (write) define return value as optional.
(close) define return value as optional.
(system) define return value as optional.
(readv) define return value as optional.
(writev) define return value as optional.
(chown) define return value as optional.
(strcpy) define return value as optional.
(strncpy) define return value as optional.
(unlink) define return value as optional.
(memcpy) define return value as optional.
(memset) define return value as optional.
(memmove) define return value as optional.
(setenv) define return value as optional.
(ftime) define return value as optional.
(shutdown) define return value as optional.
(rename) define return value as optional.
(atexit) define return value as optional.
(Makefile.in): Rebuilt.
Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Diff:
---
gcc/m2/Make-lang.in | 4 +--
gcc/m2/gm2-compiler/CLexBuf.mod | 8 ++---
gcc/m2/gm2-compiler/M2ALU.mod | 14 +++++++--
gcc/m2/gm2-compiler/M2Base.mod | 3 +-
gcc/m2/gm2-compiler/M2CaseList.def | 2 +-
gcc/m2/gm2-compiler/M2CaseList.mod | 55 ++++++++++++++++-------------------
gcc/m2/gm2-compiler/M2GenGCC.mod | 58 ++++---------------------------------
gcc/m2/gm2-compiler/M2Range.mod | 4 +--
gcc/m2/gm2-compiler/M2Search.mod | 32 ++++++++++++++------
gcc/m2/gm2-compiler/M2Swig.mod | 22 +++++++-------
gcc/m2/gm2-compiler/ObjectFiles.mod | 10 +++----
gcc/m2/gm2-compiler/PCSymBuild.mod | 2 ++
gcc/m2/gm2-compiler/Sets.mod | 9 +++---
gcc/m2/gm2-compiler/SymbolTable.mod | 26 +++++++++++++----
gcc/m2/gm2-compiler/cflex.def | 9 +++++-
gcc/m2/gm2-libs-min/libc.c | 4 +++
gcc/m2/gm2-libs/libc.def | 37 +++++++++++------------
gm2tools/Makefile.in | 2 +-
18 files changed, 150 insertions(+), 151 deletions(-)
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 32029630a31..5f80c9b7f84 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -671,7 +671,7 @@ GM2-COMP-BOOT-DEFS = FifoQueue.def M2Debug.def M2Optimize.def M2Defaults.
P0SyntaxCheck.def \
P1Build.def P2Build.def P3Build.def PHBuild.def \
M2Printf.def bnflex.def M2Quiet.def M2Preprocess.def \
- cflex.def CLexBuf.def M2Bitset.def M2Size.def \
+ M2Bitset.def M2Size.def \
M2Scope.def M2Range.def M2Swig.def \
M2MetaError.def Sets.def M2CaseList.def PCSymBuild.def \
PCBuild.def M2Const.def M2DebugStack.def \
@@ -693,7 +693,7 @@ GM2-COMP-BOOT-MODS = FifoQueue.mod M2LexBuf.mod \
SymbolConversion.mod M2Base.mod \
M2ALU.mod M2System.mod Lists.mod \
M2Printf.mod bnflex.mod M2Quiet.mod M2Search.mod \
- M2Preprocess.mod CLexBuf.mod M2Bitset.mod \
+ M2Preprocess.mod M2Bitset.mod \
M2Size.mod M2Scope.mod M2Range.mod \
M2Swig.mod M2MetaError.mod Sets.mod M2CaseList.mod \
PCSymBuild.mod M2Const.mod M2DebugStack.mod \
diff --git a/gcc/m2/gm2-compiler/CLexBuf.mod b/gcc/m2/gm2-compiler/CLexBuf.mod
index 947ad7c3081..193fe9376dd 100644
--- a/gcc/m2/gm2-compiler/CLexBuf.mod
+++ b/gcc/m2/gm2-compiler/CLexBuf.mod
@@ -621,7 +621,6 @@ END DisplayToken ;
PROCEDURE GetToken ;
VAR
- a: ADDRESS ;
t: CARDINAL ;
b: TokenBucket ;
l: CARDINAL ;
@@ -648,7 +647,7 @@ BEGIN
ELSE
IF ListOfTokens.tail=NIL
THEN
- a := cflex.GetToken() ;
+ cflex.AdvanceToken ;
IF ListOfTokens.tail=NIL
THEN
HALT
@@ -685,7 +684,7 @@ BEGIN
END ;
INC(CurrentTokNo)
ELSE
- a := cflex.GetToken() ;
+ cflex.AdvanceToken ;
GetToken ;
(* printf0('\n'); cflex.CError(string(InitString('current token'))) ; *)
END
@@ -903,8 +902,6 @@ END GetFileName ;
PROCEDURE AddTokToList (t: toktype; n: Name;
i: INTEGER; l: CARDINAL; f: SourceList) ;
-VAR
- b: TokenBucket ;
BEGIN
IF ListOfTokens.head=NIL
THEN
@@ -948,7 +945,6 @@ END AddTokToList ;
PROCEDURE IsLastTokenEof () : BOOLEAN ;
VAR
- t: CARDINAL ;
b: TokenBucket ;
BEGIN
IF ListOfTokens.tail#NIL
diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index fc54c755254..8356d8bc995 100644
--- a/gcc/m2/gm2-compiler/M2ALU.mod
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -963,6 +963,16 @@ BEGIN
END Push ;
+(*
+ Reduce - remove the top element of the stack.
+*)
+
+PROCEDURE Reduce ;
+BEGIN
+ Dispose (Pop ())
+END Reduce ;
+
+
(*
PrintValue - debugging procedure to display the value on the top of the stack.
*)
@@ -2971,10 +2981,10 @@ BEGIN
WHILE i#NIL DO
PushValue(i^.low) ;
PrintValue ;
- t := PopIntegerTree() ;
+ Reduce ;
PushValue(i^.high) ;
PrintValue ;
- t := PopIntegerTree() ;
+ Reduce ;
i := i^.next
END
END DisplayElements ;
diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod
index 77b194fd63c..a1df4261039 100644
--- a/gcc/m2/gm2-compiler/M2Base.mod
+++ b/gcc/m2/gm2-compiler/M2Base.mod
@@ -140,7 +140,6 @@ TYPE
CompatibilityArray = ARRAY MetaType, MetaType OF Compatible ;
VAR
- Param,
Expr,
Ass : CompatibilityArray ;
Ord,
@@ -1546,6 +1545,8 @@ VAR
ga, gb: CARDINAL ;
BEGIN
i := 1 ;
+ ga := NulSym ;
+ gb := NulSym ;
REPEAT
fa := GetNth(a, i) ;
fb := GetNth(b, i) ;
diff --git a/gcc/m2/gm2-compiler/M2CaseList.def b/gcc/m2/gm2-compiler/M2CaseList.def
index 8c5d275638a..b5f22b3b09c 100644
--- a/gcc/m2/gm2-compiler/M2CaseList.def
+++ b/gcc/m2/gm2-compiler/M2CaseList.def
@@ -91,7 +91,7 @@ PROCEDURE CaseBoundsResolved (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
compatible with the tagged type.
*)
-PROCEDURE TypeCaseBounds (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
+PROCEDURE TypeCaseBounds (c: CARDINAL) : BOOLEAN ;
(*
diff --git a/gcc/m2/gm2-compiler/M2CaseList.mod b/gcc/m2/gm2-compiler/M2CaseList.mod
index e8a9cda4510..c2392b7c55b 100644
--- a/gcc/m2/gm2-compiler/M2CaseList.mod
+++ b/gcc/m2/gm2-compiler/M2CaseList.mod
@@ -43,27 +43,23 @@ FROM SymbolTable IMPORT NulSym, IsConst, IsFieldVarient, IsRecord, IsRecordField
ForeachLocalSymDo, GetSymName, IsEnumeration, SkipType ;
TYPE
- RangePair = POINTER TO rangePair ;
- rangePair = RECORD
+ RangePair = POINTER TO RECORD
low, high: CARDINAL ;
tokenno : CARDINAL ;
END ;
- ConflictingPair = POINTER TO conflictingPair ;
- conflictingPair = RECORD
+ ConflictingPair = POINTER TO RECORD
a, b: RangePair ;
END ;
- CaseList = POINTER TO caseList ;
- caseList = RECORD
+ CaseList = POINTER TO RECORD
maxRangeId : CARDINAL ;
rangeArray : Index ;
currentRange: RangePair ;
varientField: CARDINAL ;
END ;
- CaseDescriptor = POINTER TO caseDescriptor ;
- caseDescriptor = RECORD
+ CaseDescriptor = POINTER TO RECORD
elseClause : BOOLEAN ;
elseField : CARDINAL ;
record : CARDINAL ;
@@ -74,8 +70,7 @@ TYPE
next : CaseDescriptor ;
END ;
- SetRange = POINTER TO setRange ;
- setRange = RECORD
+ SetRange = POINTER TO RECORD
low, high: Tree ;
next : SetRange ;
END ;
@@ -373,7 +368,7 @@ END SeenBefore ;
Overlaps -
*)
-PROCEDURE Overlaps (tokenno: CARDINAL; r, s: RangePair) : BOOLEAN ;
+PROCEDURE Overlaps (r, s: RangePair) : BOOLEAN ;
VAR
a, b, c, d: CARDINAL ;
BEGIN
@@ -389,8 +384,8 @@ BEGIN
THEN
IF NOT SeenBefore(r, s)
THEN
- MetaErrorT2(r^.tokenno, 'case label {%1ad} is a duplicate with {%2ad}', a, c) ;
- MetaErrorT2(s^.tokenno, 'case label {%1ad} is a duplicate with {%2ad}', c, a)
+ MetaErrorT2 (r^.tokenno, 'case label {%1ad} is a duplicate with {%2ad}', a, c) ;
+ MetaErrorT2 (s^.tokenno, 'case label {%1ad} is a duplicate with {%2ad}', c, a)
END ;
RETURN( TRUE )
END
@@ -398,10 +393,10 @@ BEGIN
d := s^.high ;
IF OverlapsRange(Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
THEN
- IF NOT SeenBefore(r, s)
+ IF NOT SeenBefore (r, s)
THEN
- MetaErrorT3(r^.tokenno, 'case label {%1ad} is a duplicate in the range {%2ad}..{%3ad}', a, c, d) ;
- MetaErrorT3(s^.tokenno, 'case range {%2ad}..{%3ad} is a duplicate of case label {%1ad}', c, d, a)
+ MetaErrorT3 (r^.tokenno, 'case label {%1ad} is a duplicate in the range {%2ad}..{%3ad}', a, c, d) ;
+ MetaErrorT3 (s^.tokenno, 'case range {%2ad}..{%3ad} is a duplicate of case label {%1ad}', c, d, a)
END ;
RETURN( TRUE )
END
@@ -411,12 +406,12 @@ BEGIN
IF s^.high=NulSym
THEN
d := c ;
- IF OverlapsRange(Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
+ IF OverlapsRange (Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
THEN
IF NOT SeenBefore(r, s)
THEN
- MetaErrorT3(r^.tokenno, 'case range {%1ad}..{%2ad} is a duplicate with case label {%3ad}', a, b, c) ;
- MetaErrorT3(s^.tokenno, 'case label {%1ad} is a duplicate with case range %{2ad}..{%3ad}', c, a, b)
+ MetaErrorT3 (r^.tokenno, 'case range {%1ad}..{%2ad} is a duplicate with case label {%3ad}', a, b, c) ;
+ MetaErrorT3 (s^.tokenno, 'case label {%1ad} is a duplicate with case range %{2ad}..{%3ad}', c, a, b)
END ;
RETURN( TRUE )
END
@@ -426,8 +421,8 @@ BEGIN
THEN
IF NOT SeenBefore(r, s)
THEN
- MetaErrorT4(r^.tokenno, 'case range {%1ad}..{%2ad} overlaps case range {%3ad}..{%4ad}', a, b, c, d) ;
- MetaErrorT4(s^.tokenno, 'case range {%1ad}..{%2ad} overlaps case range {%3ad}..{%4ad}', c, d, a, b)
+ MetaErrorT4 (r^.tokenno, 'case range {%1ad}..{%2ad} overlaps case range {%3ad}..{%4ad}', a, b, c, d) ;
+ MetaErrorT4 (s^.tokenno, 'case range {%1ad}..{%2ad} overlaps case range {%3ad}..{%4ad}', c, d, a, b)
END ;
RETURN( TRUE )
END
@@ -442,7 +437,7 @@ END Overlaps ;
case statement, c.
*)
-PROCEDURE OverlappingCaseBound (tokenno: CARDINAL; r: RangePair; c: CARDINAL) : BOOLEAN ;
+PROCEDURE OverlappingCaseBound (r: RangePair; c: CARDINAL) : BOOLEAN ;
VAR
p : CaseDescriptor ;
q : CaseList ;
@@ -450,22 +445,22 @@ VAR
i, j : CARDINAL ;
overlap: BOOLEAN ;
BEGIN
- p := GetIndice(caseArray, c) ;
+ p := GetIndice (caseArray, c) ;
overlap := FALSE ;
WITH p^ DO
i := 1 ;
WHILE i<=maxCaseId DO
- q := GetIndice(caseListArray, i) ;
+ q := GetIndice (caseListArray, i) ;
j := 1 ;
WHILE j<=q^.maxRangeId DO
- s := GetIndice(q^.rangeArray, j) ;
- IF (s#r) AND Overlaps(tokenno, r, s)
+ s := GetIndice (q^.rangeArray, j) ;
+ IF (s#r) AND Overlaps (r, s)
THEN
overlap := TRUE
END ;
- INC(j)
+ INC (j)
END ;
- INC(i)
+ INC (i)
END
END ;
RETURN( overlap )
@@ -495,7 +490,7 @@ BEGIN
j := 1 ;
WHILE j<=q^.maxRangeId DO
r := GetIndice(q^.rangeArray, j) ;
- IF OverlappingCaseBound(tokenno, r, c)
+ IF OverlappingCaseBound (r, c)
THEN
overlap := TRUE
END ;
@@ -865,7 +860,7 @@ END inRange ;
compatible with the tagged type.
*)
-PROCEDURE TypeCaseBounds (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
+PROCEDURE TypeCaseBounds (c: CARDINAL) : BOOLEAN ;
VAR
p : CaseDescriptor ;
q : CaseList ;
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 1d1666508cc..a6bc3fca785 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -2114,6 +2114,7 @@ END ConvertRHS ;
ConvertForComparison - converts, sym, into a tree which is type compatible with, with.
*)
+(*
PROCEDURE ConvertForComparison (tokenno: CARDINAL; sym, with: CARDINAL) : Tree ;
VAR
symType,
@@ -2145,6 +2146,7 @@ BEGIN
RETURN( t )
END
END ConvertForComparison ;
+*)
(*
@@ -3053,29 +3055,6 @@ BEGIN
END CodeInitAddress ;
-(*
- IsWord - return TRUE if type is SYSTEM.WORD, or any of the sized WORD,
- (SYSTEM.WORD32 etc).
-*)
-
-PROCEDURE IsWord (type: CARDINAL) : BOOLEAN ;
-BEGIN
- type := SkipType(type) ;
- RETURN( (type=Word) OR IsWordN(type) )
-END IsWord ;
-
-
-(*
- HaveDifferentTypes - returns TRUE if consts or variables, l, r,
- have different types.
-*)
-
-PROCEDURE HaveDifferentTypes (l, r: CARDINAL) : BOOLEAN ;
-BEGIN
- RETURN( SkipType(GetType(l))#SkipType(GetType(r)) )
-END HaveDifferentTypes ;
-
-
(*
checkRecordTypes - returns TRUE if op1 is not a record or if the record
is the same type as op2.
@@ -4699,11 +4678,13 @@ END CodeSetRotate ;
FoldSetLogicalDifference - check whether we can fold a logical difference.
*)
+(*
PROCEDURE FoldSetLogicalDifference (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
BEGIN
FoldBinarySet(tokenno, p, SetDifference, quad, op1, op2, op3)
END FoldSetLogicalDifference ;
+*)
(*
@@ -5417,6 +5398,7 @@ END CodeSize ;
We return the Varient symbol if sym was declared in the second method.
*)
+(*
PROCEDURE DetermineFieldOf (parent, sym: CARDINAL) : CARDINAL ;
VAR
varient: CARDINAL ;
@@ -5435,6 +5417,7 @@ BEGIN
RETURN( sym )
END
END DetermineFieldOf ;
+*)
(*
@@ -6410,35 +6393,6 @@ BEGIN
END FoldCast ;
-(*
- CodeMath - translates the MathOp into a GCC tree structure.
- Op2 := Op1(Op3)
-
- where:
-
- Op1 function
- Op2 return variable
- Op3 parameter
-*)
-
-PROCEDURE CodeMath (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
-VAR
- t : Tree ;
- location: location_t ;
-BEGIN
- DeclareConstant(CurrentQuadToken, op3) ; (* checks to see whether it is a constant literal and declares it *)
- DeclareConstructor(CurrentQuadToken, quad, op3) ;
- location := TokenToLocation(CurrentQuadToken) ;
-
- IF IsTrunc(op1)
- THEN
- t := BuildAssignmentTree(location, Mod2Gcc(op2), BuildTrunc(Mod2Gcc(op3)))
- ELSE
- InternalError ('unknown math operator')
- END ;
-END CodeMath ;
-
-
(*
CreateLabelProcedureN - creates a label using procedure name and
an integer.
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index a9e3f9baaf6..786472c7956 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -1948,7 +1948,7 @@ BEGIN
WITH p^ DO
IF CaseBoundsResolved(tokenno, caseList)
THEN
- IF TypeCaseBounds(tokenno, caseList)
+ IF TypeCaseBounds (caseList)
THEN
(* nothing to do *)
END ;
@@ -1982,7 +1982,7 @@ PROCEDURE CodeCaseBounds (tokenno: CARDINAL; caseList: CARDINAL; function, messa
BEGIN
IF CaseBoundsResolved(tokenno, caseList)
THEN
- IF TypeCaseBounds(tokenno, caseList)
+ IF TypeCaseBounds (caseList)
THEN
(* nothing to do *)
END ;
diff --git a/gcc/m2/gm2-compiler/M2Search.mod b/gcc/m2/gm2-compiler/M2Search.mod
index 9450d0d389a..d6f62904d64 100644
--- a/gcc/m2/gm2-compiler/M2Search.mod
+++ b/gcc/m2/gm2-compiler/M2Search.mod
@@ -24,6 +24,7 @@ IMPLEMENTATION MODULE M2Search ;
FROM SFIO IMPORT Exists ;
FROM M2FileName IMPORT CalculateFileName ;
+FROM Assertion IMPORT Assert ;
FROM DynamicStrings IMPORT InitString, InitStringChar,
KillString, ConCat, ConCatChar, Index, Slice,
@@ -34,13 +35,16 @@ FROM DynamicStrings IMPORT InitString, InitStringChar,
CONST
- Directory = '/' ;
+ Directory = '/' ;
+ GarbageDebugging = FALSE ;
VAR
Def, Mod,
UserPath,
InitialPath: String ;
+(* Internal garbage collection debugging routines. *)
+
(*
#define InitString(X) InitStringDB(X, __FILE__, __LINE__)
#define InitStringCharStar(X) InitStringCharStarDB(X, __FILE__, __LINE__)
@@ -52,27 +56,32 @@ VAR
(*
- doDSdbEnter -
-*)
+ doDSdbEnter - called when compiled with -fcpp to enable runtime garbage
+ collection debugging.
PROCEDURE doDSdbEnter ;
BEGIN
PushAllocation
END doDSdbEnter ;
+*)
(*
- doDSdbExit -
-*)
+ doDSdbExit - called when compiled with -fcpp to enable runtime garbage
+ collection debugging. The parameter string s is exempt from
+ garbage collection analysis.
PROCEDURE doDSdbExit (s: String) ;
BEGIN
- s := PopAllocationExemption(TRUE, s)
+ (* Check to see whether no strings have been lost since the PushAllocation. *)
+ Assert (PopAllocationExemption (TRUE, s) = s)
END doDSdbExit ;
+*)
(*
- DSdbEnter -
+ DSdbEnter - dummy nop entry code which the preprocessor replaces by
+ doDSsbEnter when debugging garbage collection at runtime.
*)
PROCEDURE DSdbEnter ;
@@ -81,11 +90,16 @@ END DSdbEnter ;
(*
- DSdbExit -
+ DSdbExit - dummy nop exit code which the preprocessor replaces by
+ doDSsbExit when debugging garbage collection at runtime.
*)
PROCEDURE DSdbExit (s: String) ;
BEGIN
+ IF GarbageDebugging
+ THEN
+ Assert (s # NIL)
+ END
END DSdbExit ;
@@ -109,7 +123,7 @@ BEGIN
ELSE
UserPath := ConCat(ConCatChar(UserPath, ':'), path)
END ;
- DSdbExit(UserPath)
+ DSdbExit (UserPath)
END PrependSearchPath ;
diff --git a/gcc/m2/gm2-compiler/M2Swig.mod b/gcc/m2/gm2-compiler/M2Swig.mod
index d07ac230598..3b8bac62410 100644
--- a/gcc/m2/gm2-compiler/M2Swig.mod
+++ b/gcc/m2/gm2-compiler/M2Swig.mod
@@ -369,7 +369,7 @@ END TryDependents ;
DoResolveOrder - resolves the declaration order for swig (C).
*)
-PROCEDURE DoResolveOrder (main: CARDINAL) ;
+PROCEDURE DoResolveOrder ;
VAR
sym,
i, n : CARDINAL ;
@@ -589,7 +589,7 @@ END DoBasicBlock ;
DetermineParameter -
*)
-PROCEDURE DetermineParameter (procedure, param: CARDINAL; annotate: BOOLEAN) ;
+PROCEDURE DetermineParameter (procedure, param: CARDINAL) ;
VAR
sb: ScopeBlock ;
bb: BasicBlock ;
@@ -643,7 +643,7 @@ BEGIN
THEN
InternalError ('why did we get here')
ELSE
- DetermineParameter(procedure, sym, annotate) ;
+ DetermineParameter(procedure, sym) ;
IF annotate
THEN
DoParamName(sym) ;
@@ -931,14 +931,14 @@ END DoWriteFile ;
PROCEDURE DoGenerateSwig (sym: CARDINAL) ;
BEGIN
Init ;
- name := ConCat(InitStringCharStar(KeyToCharStar(GetSymName(sym))),
- Mark(InitString('.i'))) ;
- f := OpenToWrite(name) ;
- ForeachExportedDo(sym, DoExported) ;
- DoResolveOrder(sym) ;
- DoWriteFile(sym) ;
- Close(f) ;
- name := KillString(name) ;
+ name := ConCat (InitStringCharStar (KeyToCharStar (GetSymName (sym))),
+ Mark (InitString ('.i'))) ;
+ f := OpenToWrite (name) ;
+ ForeachExportedDo (sym, DoExported) ;
+ DoResolveOrder ;
+ DoWriteFile (sym) ;
+ Close (f) ;
+ name := KillString (name) ;
Kill
END DoGenerateSwig ;
diff --git a/gcc/m2/gm2-compiler/ObjectFiles.mod b/gcc/m2/gm2-compiler/ObjectFiles.mod
index 5f7f1212a61..b495bb56788 100644
--- a/gcc/m2/gm2-compiler/ObjectFiles.mod
+++ b/gcc/m2/gm2-compiler/ObjectFiles.mod
@@ -32,6 +32,7 @@ FROM wrapc IMPORT fileinode ;
FROM libc IMPORT open, close ;
FROM M2Printf IMPORT fprintf1, fprintf0 ;
FROM FIO IMPORT StdErr ;
+FROM Assertion IMPORT Assert ;
CONST
@@ -56,7 +57,6 @@ TYPE
PROCEDURE RegisterModuleObject (fo: FileObjects; location: String) : BOOLEAN ;
VAR
p: FileObject ;
- r,
f: INTEGER ;
BEGIN
IF Debugging
@@ -70,7 +70,7 @@ BEGIN
f := open (string (location), UNIXREADONLY, 0) ;
IF fileinode (f, p^.inodeLow, p^.inodeHigh) = 0
THEN
- r := close (f) ;
+ close (f) ;
IncludeIndiceIntoIndex (fo^.objects, p) ;
IF Debugging
THEN
@@ -83,7 +83,7 @@ BEGIN
fprintf0 (StdErr, " fileinode failed\n")
END
END ;
- r := close (f) ;
+ close (f) ;
DISPOSE (p)
END ;
IF Debugging
@@ -132,12 +132,12 @@ END isRegistered ;
PROCEDURE IsRegistered (fo: FileObjects; location: String) : BOOLEAN ;
VAR
- f, r : INTEGER ;
+ f : INTEGER ;
result: BOOLEAN ;
BEGIN
f := open (string (location), UNIXREADONLY, 0) ;
result := isRegistered (fo, f) ;
- r := close (f) ;
+ close (f) ;
RETURN result
END IsRegistered ;
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
index b0986f25e66..6f5d69d85cc 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -2069,10 +2069,12 @@ END WalkDes ;
is changed.
*)
+(*
PROCEDURE WalkConst (sym: CARDINAL) : BOOLEAN ;
BEGIN
RETURN( WalkDes(findConstDes(sym)) )
END WalkConst ;
+*)
(*
diff --git a/gcc/m2/gm2-compiler/Sets.mod b/gcc/m2/gm2-compiler/Sets.mod
index c0284b0b7da..b356aaf9649 100644
--- a/gcc/m2/gm2-compiler/Sets.mod
+++ b/gcc/m2/gm2-compiler/Sets.mod
@@ -27,6 +27,7 @@ FROM M2Error IMPORT InternalError ;
FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ;
FROM libc IMPORT memset, memcpy ;
FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM Assertion IMPORT Assert ;
CONST
@@ -68,7 +69,6 @@ VAR
bits,
o, j: CARDINAL ;
b : PtrToBitset ;
- a : ADDRESS ;
v : PtrToByte ;
BEGIN
WITH s^ DO
@@ -112,8 +112,8 @@ BEGIN
(* a := memset(b, 0, bytes) ; *)
v := PtrToByte(b) ;
INC(v, o) ;
- a := memset(v, 0, bytes-o) ;
- a := memcpy(b, pb, o) ;
+ Assert (memset (v, 0, bytes-o) = v) ;
+ Assert (memcpy (b, pb, o) = b) ;
IF Debugging
THEN
printf1("deallocating old bitset size %d bytes\n", o)
@@ -194,13 +194,12 @@ END KillSet ;
PROCEDURE DuplicateSet (s: Set) : Set ;
VAR
t: Set ;
- a: ADDRESS ;
BEGIN
NEW(t) ;
t^ := s^ ;
WITH t^ DO
ALLOCATE(pb, bytes) ;
- a := memcpy(pb, s^.pb, bytes)
+ Assert (memcpy (pb, s^.pb, bytes) = pb)
END ;
RETURN( t )
END DuplicateSet ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 49dd55c1f84..f3e6b0b5bd6 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -47,7 +47,7 @@ FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3, MetaErrors1,
MetaErrorT0,
MetaErrorString1,
MetaErrorStringT0, MetaErrorStringT1,
- MetaErrorT1 ;
+ MetaErrorT1, MetaErrorT2 ;
FROM M2LexBuf IMPORT GetTokenNo ;
FROM FormatStrings IMPORT Sprintf1 ;
@@ -1114,6 +1114,7 @@ END AlreadyDeclaredError ;
the places where the symbols was imported and also declared.
*)
+(*
PROCEDURE AlreadyImportedError (s: String; name: Name; OtherOccurance: CARDINAL) ;
VAR
e: Error ;
@@ -1129,6 +1130,7 @@ BEGIN
ErrorFormat1(e, 'and symbol (%a) was also seen here', name)
END
END AlreadyImportedError ;
+*)
(*
@@ -2579,6 +2581,7 @@ END CheckScopeForSym ;
a requested symbol.
*)
+(*
PROCEDURE DisplayScopes ;
VAR
pCall: PtrToCallFrame ;
@@ -2606,6 +2609,7 @@ BEGIN
END ;
printf0('\n')
END DisplayScopes ;
+*)
(*
@@ -3703,6 +3707,7 @@ END MakeHiddenType ;
NulSym is returned if the symbol is unknown.
*)
+(*
PROCEDURE GetConstFromTypeTree (constName: Name; constType: CARDINAL) : CARDINAL ;
VAR
pSym: PtrToSymbol ;
@@ -3726,6 +3731,7 @@ BEGIN
END
END
END GetConstFromTypeTree ;
+*)
(*
@@ -3733,6 +3739,7 @@ END GetConstFromTypeTree ;
constName is the name of constSym.
*)
+(*
PROCEDURE PutConstIntoTypeTree (constName: Name; constType: CARDINAL; constSym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
@@ -3756,7 +3763,7 @@ BEGIN
END
END
END PutConstIntoTypeTree ;
-
+*)
(*
MakeConstLit - returns a constant literal of type, constType, with a constName,
@@ -6795,6 +6802,7 @@ END IsReallyPointer ;
it does skip over hidden type.
*)
+(*
PROCEDURE SkipHiddenType (Sym: CARDINAL) : CARDINAL ;
BEGIN
IF (Sym#NulSym) AND IsType(Sym) AND (GetType(Sym)#NulSym)
@@ -6804,6 +6812,7 @@ BEGIN
RETURN( Sym )
END
END SkipHiddenType ;
+*)
(*
@@ -6858,6 +6867,7 @@ END CheckHiddenTypeAreAddress ;
GetLastMainScopeId - returns the, id, containing the last main scope.
*)
+(*
PROCEDURE GetLastMainScopeId (id: CARDINAL) : CARDINAL ;
VAR
pCall: PtrToCallFrame ;
@@ -6878,6 +6888,7 @@ BEGIN
END ;
RETURN( 0 )
END GetLastMainScopeId ;
+*)
(*
@@ -8102,8 +8113,7 @@ END UndeclaredSymbolError ;
PROCEDURE PutExportUnImplemented (tokenno: CARDINAL; Sym: CARDINAL) ;
VAR
- pSym : PtrToSymbol ;
- n1, n2: Name ;
+ pSym: PtrToSymbol ;
BEGIN
pSym := GetPsym (CurrentModule) ;
WITH pSym^ DO
@@ -8111,10 +8121,14 @@ BEGIN
DefImpSym: IF GetSymKey (DefImp.NeedToBeImplemented, GetSymName (Sym)) = Sym
THEN
+ MetaErrorT2 (tokenno, 'symbol {%1a} is already exported from module {%2a}',
+ Sym, CurrentModule)
+ (*
n1 := GetSymName (Sym) ;
n2 := GetSymName (CurrentModule) ;
WriteFormat2 ('symbol (%a) already exported from module (%a)', n1, n2)
- ELSE
+ *)
+ ELSE
PutSymKey (DefImp.NeedToBeImplemented, GetSymName(Sym), Sym)
END
@@ -13213,6 +13227,7 @@ END GetDefaultRecordFieldAlignment ;
DumpSymbols - display all symbol numbers and their type.
*)
+(*
PROCEDURE DumpSymbols ;
VAR
pSym: PtrToSymbol ;
@@ -13265,6 +13280,7 @@ BEGIN
INC (sym)
END
END DumpSymbols ;
+*)
(*
diff --git a/gcc/m2/gm2-compiler/cflex.def b/gcc/m2/gm2-compiler/cflex.def
index ee34a3f279e..5bd1e4fa3fa 100644
--- a/gcc/m2/gm2-compiler/cflex.def
+++ b/gcc/m2/gm2-compiler/cflex.def
@@ -31,7 +31,7 @@ DEFINITION MODULE cflex ;
*)
FROM SYSTEM IMPORT ADDRESS ;
-EXPORT QUALIFIED GetToken, CError, OpenSource, CloseSource, GetLineNo,
+EXPORT QUALIFIED GetToken, AdvanceToken, CError, OpenSource, CloseSource, GetLineNo,
ParsingOn, SetSearchPath, AddTypeDef ;
@@ -57,6 +57,13 @@ PROCEDURE OpenSource (s: ADDRESS) : BOOLEAN ;
PROCEDURE GetToken () : ADDRESS ;
+(*
+ AdvanceToken - move onto the next token.
+*)
+
+PROCEDURE AdvanceToken ;
+
+
(*
GetLineNo - returns the current line number.
*)
diff --git a/gcc/m2/gm2-libs-min/libc.c b/gcc/m2/gm2-libs-min/libc.c
index e15970ab704..44e314120a7 100644
--- a/gcc/m2/gm2-libs-min/libc.c
+++ b/gcc/m2/gm2-libs-min/libc.c
@@ -29,8 +29,12 @@ void exit (int);
void abort (int i)
{
+ while (1)
+ ;
}
void exit (int i)
{
+ while (1)
+ ;
}
diff --git a/gcc/m2/gm2-libs/libc.def b/gcc/m2/gm2-libs/libc.def
index 991431bd60e..c23381744f4 100644
--- a/gcc/m2/gm2-libs/libc.def
+++ b/gcc/m2/gm2-libs/libc.def
@@ -78,14 +78,14 @@ TYPE
ssize_t write (int d, void *buf, size_t nbytes)
*)
-PROCEDURE write (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : CSSIZE_T ;
+PROCEDURE write (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : [ CSSIZE_T ] ;
(*
ssize_t read (int d, void *buf, size_t nbytes)
*)
-PROCEDURE read (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : CSSIZE_T ;
+PROCEDURE read (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : [ CSSIZE_T ] ;
(*
@@ -93,7 +93,7 @@ PROCEDURE read (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : CSSIZE_T ;
char *string;
*)
-PROCEDURE system (a: ADDRESS) : INTEGER ;
+PROCEDURE system (a: ADDRESS) : [ INTEGER ] ;
(*
@@ -196,7 +196,7 @@ PROCEDURE dup (d: INTEGER) : INTEGER ;
close - closes the file descriptor, d.
*)
-PROCEDURE close (d: INTEGER) : INTEGER ;
+PROCEDURE close (d: INTEGER) : [ INTEGER ] ;
(*
@@ -233,14 +233,14 @@ PROCEDURE perror (string: ARRAY OF CHAR);
readv - reads an io vector of bytes.
*)
-PROCEDURE readv (fd: INTEGER; v: ADDRESS; n: INTEGER) : INTEGER ;
+PROCEDURE readv (fd: INTEGER; v: ADDRESS; n: INTEGER) : [ INTEGER ] ;
(*
writev - writes an io vector of bytes.
*)
-PROCEDURE writev (fd: INTEGER; v: ADDRESS; n: INTEGER) : INTEGER ;
+PROCEDURE writev (fd: INTEGER; v: ADDRESS; n: INTEGER) : [ INTEGER ] ;
(*
@@ -271,7 +271,7 @@ PROCEDURE getcwd (buf: ADDRESS; size: CSIZE_T) : ADDRESS ;
and errno is set appropriately.
*)
-PROCEDURE chown (filename: ADDRESS; uid, gid: INTEGER) : INTEGER ;
+PROCEDURE chown (filename: ADDRESS; uid, gid: INTEGER) : [ INTEGER ] ;
(*
@@ -286,7 +286,7 @@ PROCEDURE strlen (a: ADDRESS) : CSIZE_T ;
It returns dest.
*)
-PROCEDURE strcpy (dest, src: ADDRESS) : ADDRESS ;
+PROCEDURE strcpy (dest, src: ADDRESS) : [ ADDRESS ] ;
(*
@@ -294,14 +294,14 @@ PROCEDURE strcpy (dest, src: ADDRESS) : ADDRESS ;
It returns dest.
*)
-PROCEDURE strncpy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+PROCEDURE strncpy (dest, src: ADDRESS; n: CARDINAL) : [ ADDRESS ] ;
(*
unlink - removes file and returns 0 if successful.
*)
-PROCEDURE unlink (file: ADDRESS) : INTEGER ;
+PROCEDURE unlink (file: ADDRESS) : [ INTEGER ] ;
(*
@@ -315,7 +315,7 @@ PROCEDURE unlink (file: ADDRESS) : INTEGER ;
It returns dest.
*)
-PROCEDURE memcpy (dest, src: ADDRESS; size: CSIZE_T) : ADDRESS ;
+PROCEDURE memcpy (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
(*
@@ -326,9 +326,10 @@ PROCEDURE memcpy (dest, src: ADDRESS; size: CSIZE_T) : ADDRESS ;
#include <string.h>
void *memset(void *s, int c, size_t n);
+ It returns s.
*)
-PROCEDURE memset (s: ADDRESS; c: INTEGER; size: CSIZE_T) : ADDRESS ;
+PROCEDURE memset (s: ADDRESS; c: INTEGER; size: CSIZE_T) : [ ADDRESS ] ;
(*
@@ -342,7 +343,7 @@ PROCEDURE memset (s: ADDRESS; c: INTEGER; size: CSIZE_T) : ADDRESS ;
It returns dest.
*)
-PROCEDURE memmove (dest, src: ADDRESS; size: CSIZE_T) : ADDRESS ;
+PROCEDURE memmove (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
(*
@@ -358,7 +359,7 @@ PROCEDURE printf (format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
is true. It returns 0 on success and -1 for an error.
*)
-PROCEDURE setenv (name: ADDRESS; value: ADDRESS; overwrite: INTEGER) : INTEGER ;
+PROCEDURE setenv (name: ADDRESS; value: ADDRESS; overwrite: INTEGER) : [ INTEGER ] ;
(*
@@ -396,7 +397,7 @@ PROCEDURE localtime (VAR t: time_t) : ADDRESS ;
ftime - return date and time.
*)
-PROCEDURE ftime (VAR t: timeb) : INTEGER ;
+PROCEDURE ftime (VAR t: timeb) : [ INTEGER ] ;
(*
@@ -406,14 +407,14 @@ PROCEDURE ftime (VAR t: timeb) : INTEGER ;
if how = 2, then mo more reads or writes are allowed.
*)
-PROCEDURE shutdown (s: INTEGER; how: INTEGER) : INTEGER ;
+PROCEDURE shutdown (s: INTEGER; how: INTEGER) : [ INTEGER ] ;
(*
rename - change the name or location of a file
*)
-PROCEDURE rename (oldpath, newpath: ADDRESS) : INTEGER ;
+PROCEDURE rename (oldpath, newpath: ADDRESS) : [ INTEGER ] ;
(*
@@ -441,7 +442,7 @@ PROCEDURE longjmp (env: ADDRESS; val: INTEGER) ;
atexit - execute, proc, when the function exit is called.
*)
-PROCEDURE atexit (proc: exitP) : INTEGER ;
+PROCEDURE atexit (proc: exitP) : [ INTEGER ] ;
(*
diff --git a/gm2tools/Makefile.in b/gm2tools/Makefile.in
index d228a6a9b39..386f2e4163a 100644
--- a/gm2tools/Makefile.in
+++ b/gm2tools/Makefile.in
@@ -639,8 +639,8 @@ distclean-generic:
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
-@NATIVE_FALSE@install-exec-local:
@NATIVE_FALSE@uninstall-local:
+@NATIVE_FALSE@install-exec-local:
clean: clean-am
clean-am: clean-binPROGRAMS clean-generic mostlyclean-am
next reply other threads:[~2021-08-26 19:16 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-08-26 19:16 Gaius Mulley [this message]
-- strict thread matches above, loose matches on Subject: below --
2021-08-26 19:37 Gaius Mulley
2021-08-10 11:14 Gaius Mulley
2021-08-02 9:22 Gaius Mulley
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=20210826191618.43F983858D3C@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: link
Be 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).