aboutsummaryrefslogtreecommitdiff
path: root/gcc/m2
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/m2')
-rw-r--r--gcc/m2/gm2-compiler/M2Check.mod21
-rw-r--r--gcc/m2/gm2-compiler/M2Quads.mod10
-rw-r--r--gcc/m2/gm2-compiler/M2Range.mod43
-rw-r--r--gcc/m2/gm2-compiler/SymbolTable.def16
-rw-r--r--gcc/m2/gm2-compiler/SymbolTable.mod137
-rw-r--r--gcc/m2/gm2-libs/FormatStrings.mod4
6 files changed, 209 insertions, 22 deletions
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 528c51d..d86ef8e 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -803,7 +803,12 @@ BEGIN
THEN
typeRight := GetDType (right) ;
typeLeft := GetDType (left) ;
- RETURN doCheckPair (result, tinfo, typeLeft, typeRight)
+ IF IsZRCType (typeLeft) AND IsUnbounded (typeRight)
+ THEN
+ RETURN false
+ ELSE
+ RETURN doCheckPair (result, tinfo, typeLeft, typeRight)
+ END
END ;
RETURN result
END checkConstMeta ;
@@ -868,7 +873,19 @@ END checkSubrangeTypeEquivalence ;
(*
- isZRC -
+ IsZRCType - return TRUE if type is a ZType, RType or a CType.
+*)
+
+PROCEDURE IsZRCType (type: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN (type = CType) OR (type = ZType) OR (type = RType)
+END IsZRCType ;
+
+
+(*
+ isZRC - return TRUE if zrc is a ZType, RType or a CType
+ and sym is either a complex type when zrc = CType
+ or is not a composite type when zrc is a RType or ZType.
*)
PROCEDURE isZRC (zrc, sym: CARDINAL) : BOOLEAN ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 9bb8c4d..4022657 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -69,6 +69,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
GetArraySubscript, GetDimension,
GetParam,
GetNth, GetNthParamAny,
+ GetNthParamAnyClosest,
GetFirstUsed, GetDeclaredMod,
GetQuads, GetReadQuads, GetWriteQuads,
GetWriteLimitQuads, GetReadLimitQuads,
@@ -5676,7 +5677,8 @@ BEGIN
WHILE i<=ParamTotal DO
IF i <= NoOfParamAny (Proc)
THEN
- FormalI := GetParam(Proc, i) ;
+ (* FormalI := GetParam(Proc, i) ; *)
+ FormalI := GetNthParamAnyClosest (Proc, i, GetCurrentModule ()) ;
IF CompilerDebugging
THEN
n1 := GetSymName(FormalI) ;
@@ -5801,7 +5803,7 @@ BEGIN
MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', call, GetNth (call, i), i)
END ;
BuildRange (InitTypesParameterCheck (tokno, CheckedProcedure, i,
- GetParam (CheckedProcedure, i),
+ GetNthParamAnyClosest (CheckedProcedure, i, GetCurrentModule ()),
GetParam (ProcType, i), ParamCheckId)) ;
INC(i)
END
@@ -6150,7 +6152,7 @@ BEGIN
MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo) ;
IF NoOfParamAny (ProcedureSym) >= ParameterNo
THEN
- FormalParam := GetNthParamAny (ProcedureSym, ParameterNo) ;
+ FormalParam := GetNthParamAnyClosest (ProcedureSym, ParameterNo, GetCurrentModule ()) ;
IF IsUnboundedParamAny (ProcedureSym, ParameterNo)
THEN
MetaErrorT2 (GetVarDeclFullTok (FormalParam), 'formal parameter {%1ad} has an open array type {%2tad}',
@@ -6205,7 +6207,7 @@ BEGIN
MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo) ;
IF NoOfParamAny (ProcedureSym) >= ParameterNo
THEN
- FormalParam := GetNthParamAny (ProcedureSym, ParameterNo) ;
+ FormalParam := GetNthParamAnyClosest (ProcedureSym, ParameterNo, GetCurrentModule ()) ;
IF IsUnboundedParamAny (ProcedureSym, ParameterNo)
THEN
MetaErrorT2 (GetVarDeclFullTok (FormalParam), '{%W}formal parameter {%1ad} has an open array type {%2tad}',
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index 2a5bfab..8e3943a 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -154,6 +154,34 @@ TYPE
VAR
TopOfRange: CARDINAL ;
RangeIndex: Index ;
+ BreakRange: CARDINAL ;
+
+
+PROCEDURE gdbhook ;
+END gdbhook ;
+
+
+(*
+ BreakWhenRangeCreated - to be called interactively by gdb.
+*)
+
+PROCEDURE BreakWhenRangeCreated (r: CARDINAL) ;
+BEGIN
+ BreakRange := r
+END BreakWhenRangeCreated ;
+
+
+(*
+ CheckBreak - if sym = BreakRange then call gdbhook.
+*)
+
+PROCEDURE CheckBreak (r: CARDINAL) ;
+BEGIN
+ IF BreakRange = r
+ THEN
+ gdbhook
+ END
+END CheckBreak ;
(*
@@ -302,6 +330,7 @@ BEGIN
THEN
InternalError ('out of memory error')
ELSE
+ CheckBreak (r) ;
WITH p^ DO
type := none ;
des := NulSym ;
@@ -3746,7 +3775,19 @@ END WriteRangeCheck ;
PROCEDURE Init ;
BEGIN
TopOfRange := 0 ;
- RangeIndex := InitIndex(1)
+ RangeIndex := InitIndex(1) ;
+ BreakWhenRangeCreated (0) ; (* Disable the intereactive range watch. *)
+ (* To examine the range when it is created run cc1gm2 from gdb
+ and set a break point on gdbhook.
+ (gdb) break gdbhook
+ (gdb) run
+ Now below interactively call BreakWhenRangeCreated with the symbol
+ under investigation. *)
+ gdbhook ;
+ (* Now is the time to interactively call gdb, for example:
+ (gdb) print BreakWhenRangeCreated (1234)
+ (gdb) cont
+ and you will arrive at gdbhook when this symbol is created. *)
END Init ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 85a3672..2a9865a 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -3478,4 +3478,20 @@ PROCEDURE UsesOptArgAny (Sym: CARDINAL) : BOOLEAN ;
PROCEDURE GetProcedureKindDesc (kind: ProcedureKind) : String ;
+(*
+ GetNthParamAnyClosest - returns the nth parameter from the order
+ proper procedure, forward declaration
+ or definition module procedure.
+ It chooses the parameter which is closest
+ in source terms to currentmodule.
+ The same module will return using the order
+ proper procedure, forward procedure, definition module.
+ Whereas an imported procedure will choose from
+ DefProcedure, ProperProcedure, ForwardProcedure.
+*)
+
+PROCEDURE GetNthParamAnyClosest (sym: CARDINAL; ParamNo: CARDINAL;
+ currentmodule: CARDINAL) : CARDINAL ;
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 826d2d3..551bbec 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -122,8 +122,6 @@ CONST
UnboundedAddressName = "_m2_contents" ;
UnboundedHighName = "_m2_high_%d" ;
- BreakSym = 203 ;
-
TYPE
ProcAnyBoolean = PROCEDURE (CARDINAL, ProcedureKind) : BOOLEAN ;
ProcAnyCardinal = PROCEDURE (CARDINAL, ProcedureKind) : CARDINAL ;
@@ -930,6 +928,7 @@ VAR
(* passes and reduce duplicate *)
(* errors. *)
ConstLitArray : Indexing.Index ;
+ BreakSym : CARDINAL ; (* Allows interactive debugging. *)
(*
@@ -1032,11 +1031,34 @@ END FinalSymbol ;
(*
- stop - a debugger convenience hook.
+ gdbhook - a debugger convenience hook.
+*)
+
+PROCEDURE gdbhook ;
+END gdbhook ;
+
+
+(*
+ BreakWhenSymCreated - to be called interactively by gdb.
*)
-PROCEDURE stop ;
-END stop ;
+PROCEDURE BreakWhenSymCreated (sym: CARDINAL) ;
+BEGIN
+ BreakSym := sym
+END BreakWhenSymCreated ;
+
+
+(*
+ CheckBreak - if sym = BreakSym then call gdbhook.
+*)
+
+PROCEDURE CheckBreak (sym: CARDINAL) ;
+BEGIN
+ IF sym = BreakSym
+ THEN
+ gdbhook
+ END
+END CheckBreak ;
(*
@@ -1053,10 +1075,7 @@ BEGIN
SymbolType := DummySym
END ;
PutIndice(Symbols, sym, pSym) ;
- IF sym = BreakSym
- THEN
- stop
- END ;
+ CheckBreak (sym) ;
INC(FreeSymbol)
END NewSym ;
@@ -1660,6 +1679,18 @@ PROCEDURE Init ;
VAR
pCall: PtrToCallFrame ;
BEGIN
+ BreakWhenSymCreated (NulSym) ; (* Disable the intereactive sym watch. *)
+ (* To examine the symbol table when a symbol is created run cc1gm2 from gdb
+ and set a break point on gdbhook.
+ (gdb) break gdbhook
+ (gdb) run
+ Now below interactively call BreakWhenSymCreated with the symbol
+ under investigation. *)
+ gdbhook ;
+ (* Now is the time to interactively call gdb, for example:
+ (gdb) print BreakWhenSymCreated (1234)
+ (gdb) cont
+ and you will arrive at gdbhook when this symbol is created. *)
AnonymousName := 0 ;
CurrentError := NIL ;
InitTree (ConstLitPoolTree) ;
@@ -3959,10 +3990,7 @@ VAR
BEGIN
tok := CheckTok (tok, 'procedure') ;
Sym := DeclareSym(tok, ProcedureName) ;
- IF Sym = BreakSym
- THEN
- stop
- END ;
+ CheckBreak (Sym) ;
IF NOT IsError(Sym)
THEN
pSym := GetPsym(Sym) ;
@@ -6926,6 +6954,89 @@ END GetNthParamAny ;
(*
+ GetNthParamChoice - returns the parameter definition from
+ sym:ParamNo:kind or NulSym.
+*)
+
+PROCEDURE GetNthParamChoice (sym: CARDINAL; ParamNo: CARDINAL;
+ kind: ProcedureKind) : CARDINAL ;
+BEGIN
+ IF GetProcedureParametersDefined (sym, kind)
+ THEN
+ RETURN GetNthParam (sym, kind, ParamNo)
+ ELSE
+ RETURN NulSym
+ END
+END GetNthParamChoice ;
+
+
+(*
+ GetNthParamOrdered - returns the parameter definition from list {a, b, c}
+ in order.
+ sym:ParamNo:{a,b,c} or NulSym.
+*)
+
+PROCEDURE GetNthParamOrdered (sym: CARDINAL; ParamNo: CARDINAL;
+ a, b, c: ProcedureKind) : CARDINAL ;
+VAR
+ param: CARDINAL ;
+BEGIN
+ param := GetNthParamChoice (sym, ParamNo, a) ;
+ IF param = NulSym
+ THEN
+ param := GetNthParamChoice (sym, ParamNo, b) ;
+ IF param = NulSym
+ THEN
+ param := GetNthParamChoice (sym, ParamNo, c)
+ END
+ END ;
+ RETURN param
+END GetNthParamOrdered ;
+
+
+(*
+ GetNthParamAnyClosest - returns the nth parameter from the order
+ proper procedure, forward declaration
+ or definition module procedure.
+ It chooses the parameter which is closest
+ in source terms to currentmodule.
+ The same module will return using the order
+ proper procedure, forward procedure, definition module.
+ Whereas an imported procedure will choose from
+ DefProcedure, ProperProcedure, ForwardProcedure.
+*)
+
+PROCEDURE GetNthParamAnyClosest (sym: CARDINAL; ParamNo: CARDINAL;
+ currentmodule: CARDINAL) : CARDINAL ;
+BEGIN
+ IF GetOuterModuleScope (currentmodule) = GetOuterModuleScope (sym)
+ THEN
+ (* Same module. *)
+ RETURN GetNthParamOrdered (sym, ParamNo,
+ ProperProcedure, ForwardProcedure, DefProcedure)
+ ELSE
+ (* Procedure is imported. *)
+ RETURN GetNthParamOrdered (sym, ParamNo,
+ DefProcedure, ProperProcedure, ForwardProcedure)
+ END
+END GetNthParamAnyClosest ;
+
+
+(*
+ GetOuterModuleScope - returns the outer module symbol scope for sym.
+*)
+
+PROCEDURE GetOuterModuleScope (sym: CARDINAL) : CARDINAL ;
+BEGIN
+ WHILE NOT (IsDefImp (sym) OR
+ (IsModule (sym) AND (GetScope (sym) = NulSym))) DO
+ sym := GetScope (sym)
+ END ;
+ RETURN sym
+END GetOuterModuleScope ;
+
+
+(*
The Following procedures fill in the symbol table with the
symbol entities.
*)
diff --git a/gcc/m2/gm2-libs/FormatStrings.mod b/gcc/m2/gm2-libs/FormatStrings.mod
index ec2985b..aea8da9 100644
--- a/gcc/m2/gm2-libs/FormatStrings.mod
+++ b/gcc/m2/gm2-libs/FormatStrings.mod
@@ -378,7 +378,7 @@ BEGIN
THEN
INC (afterperc) ;
Cast (u, w) ;
- in := ConCat (in, Slice (fmt, startpos, nextperc)) ;
+ in := Copy (fmt, in, startpos, nextperc) ;
in := ConCat (in, CardinalToString (u, width, leader, 16, TRUE)) ;
startpos := afterperc ;
DSdbExit (NIL) ;
@@ -387,7 +387,7 @@ BEGIN
THEN
INC (afterperc) ;
Cast (u, w) ;
- in := ConCat (in, Slice (fmt, startpos, nextperc)) ;
+ in := Copy (fmt, in, startpos, nextperc) ;
in := ConCat (in, CardinalToString (u, width, leader, 10, FALSE)) ;
startpos := afterperc ;
DSdbExit (NIL) ;
generated by cgit v1.1 at 2025-04-25 08:58:15 +0000