21 files changed, 1629 insertions, 607 deletions

diff --git a/gcc/m2/gm2-compiler/M2Check.def b/gcc/m2/gm2-compiler/M2Check.def
index 0ceb173..9d9f760 100644
--- a/gcc/m2/gm2-compiler/M2Check.def
+++ b/gcc/m2/gm2-compiler/M2Check.def
@@ -50,7 +50,8 @@ PROCEDURE ParameterTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
 *)
 
 PROCEDURE AssignmentTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
-                                    des, expr: CARDINAL) : BOOLEAN ;
+                                    des, expr: CARDINAL;
+                                    enableReason: BOOLEAN) : BOOLEAN ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 528c51d..614526c 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -36,26 +36,33 @@ FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ;
 FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType, Char ;
 FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex, ForeachIndiceInIndexDo ;
 FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
-FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4, MetaError1 ;
+
+FROM M2MetaError IMPORT MetaErrorStringT0, MetaErrorStringT2, MetaErrorStringT3,
+                        MetaErrorStringT4,
+                        MetaString0, MetaString1, MetaString2, MetaString3,
+                        MetaString4,
+                        MetaError0, MetaError1 ;
+
 FROM StrLib IMPORT StrEqual ;
 FROM M2Debug IMPORT Assert ;
 
-FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
+FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetType, IsType,
                         SkipType, IsProcedure, NoOfParamAny, IsVarParamAny, GetNth,
                         GetNthParamAny, IsProcType, IsVar, IsEnumeration, IsArray,
                         IsSubrange, GetArraySubscript, IsConst,
                         IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
-                        GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
+                        GetMode, IsUnbounded, IsComposite, IsConstructor,
                         IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
                         GetStringLength, GetProcedureProcType, IsHiddenType,
-                        IsHiddenReallyPointer, GetDimension ;
+                        IsHiddenReallyPointer, GetDimension, IsFieldEnumeration ;
 
 FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
 FROM M2System IMPORT Address ;
 FROM M2ALU IMPORT Equ, PushIntegerTree ;
+FROM M2Options IMPORT StrictTypeReason ;
 FROM m2expr IMPORT AreConstantsEqual ;
-FROM SymbolConversion IMPORT Mod2Gcc ;
-FROM DynamicStrings IMPORT String, InitString, KillString ;
+FROM SymbolConversion IMPORT Mod2Gcc, GccKnowsAbout ;
+FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, Mark ;
 FROM M2LexBuf IMPORT GetTokenNo ;
 FROM Storage IMPORT ALLOCATE ;
 FROM SYSTEM IMPORT ADR ;
@@ -63,7 +70,8 @@ FROM libc IMPORT printf ;
 
 
 CONST
-   debugging = FALSE ;
+   debugging     = FALSE ;
+   MaxEquvalence = 20 ;
 
 TYPE
    errorSig = POINTER TO RECORD
@@ -83,6 +91,8 @@ TYPE
    checkType = (parameter, assignment, expression) ;
 
    tInfo = POINTER TO RECORD
+                         reasonEnable: BOOLEAN ;
+                         reason,
                          format    : String ;
                          kind      : checkType ;
                          token,
@@ -105,11 +115,14 @@ TYPE
 
    status = (true, false, unknown, visited, unused) ;
 
+   EquivalenceProcedure = PROCEDURE (status, tInfo, CARDINAL, CARDINAL) : status ;
 
 VAR
-   pairFreeList : pair ;
-   tinfoFreeList: tInfo ;
-   errors       : Index ;
+   pairFreeList   : pair ;
+   tinfoFreeList  : tInfo ;
+   errors         : Index ;
+   HighEquivalence: CARDINAL ;
+   Equivalence    : ARRAY [1..MaxEquvalence] OF EquivalenceProcedure ;
 
 
 (*
@@ -159,6 +172,53 @@ END dumptInfo ;
 
 
 (*
+   falseReason2 - return false.  It also stores the message as the
+                  reason for the false value.
+*)
+
+PROCEDURE falseReason2 (message: ARRAY OF CHAR; tinfo: tInfo;
+                        left, right: CARDINAL) : status ;
+BEGIN
+   IF tinfo^.reasonEnable AND (tinfo^.reason = NIL)
+   THEN
+      tinfo^.reason := MetaString2 (InitString (message), left, right)
+   END ;
+   RETURN false
+END falseReason2 ;
+
+
+(*
+   falseReason1 - return false.  It also stores the message as the
+                  reason for the false value.
+*)
+
+PROCEDURE falseReason1 (message: ARRAY OF CHAR; tinfo: tInfo;
+                        operand: CARDINAL) : status ;
+BEGIN
+   IF tinfo^.reasonEnable AND (tinfo^.reason = NIL)
+   THEN
+      tinfo^.reason := MetaString1 (InitString (message), operand)
+   END ;
+   RETURN false
+END falseReason1 ;
+
+
+(*
+   falseReason0 - return false.  It also stores the message as the
+                  reason for the false value.
+*)
+
+PROCEDURE falseReason0 (message: ARRAY OF CHAR; tinfo: tInfo) : status ;
+BEGIN
+   IF tinfo^.reasonEnable AND (tinfo^.reason = NIL)
+   THEN
+      tinfo^.reason := MetaString0 (InitString (message))
+   END ;
+   RETURN false
+END falseReason0 ;
+
+
+(*
    isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
 *)
 
@@ -192,31 +252,29 @@ END isFalse ;
    checkTypeEquivalence - returns TRUE if left and right can be skipped and found to be equal.
 *)
 
-PROCEDURE checkTypeEquivalence (result: status; left, right: CARDINAL) : status ;
-VAR
-   leftT, rightT: CARDINAL ;
+PROCEDURE checkTypeEquivalence (result: status;
+                                tinfo: tInfo;
+                                left, right: CARDINAL) : status ;
 BEGIN
-   (* firstly check to see if we already have resolved this as false.  *)
-   IF isFalse (result)
+   IF left = right
    THEN
-      RETURN result
-   ELSE
-      (* check to see if we dont care about left or right.  *)
-      IF (left = NulSym) OR (right = NulSym)
+      RETURN true
+   ELSIF IsType (left) AND IsType (right)
+   THEN
+      IF IsHiddenType (left) AND IsHiddenType (right)
+      THEN
+         RETURN falseReason2 ('opaque types {%1a} {%2a} differ', tinfo, left, right)
+      ELSIF (IsHiddenType (left) AND (right = Address)) OR
+            (IsHiddenType (right) AND (left = Address))
       THEN
          RETURN true
-      ELSE
-         leftT := SkipType (left) ;
-         rightT := SkipType (right) ;
-         IF leftT = rightT
-         THEN
-            RETURN true
-         ELSIF IsType (leftT) AND IsType (rightT)
-         THEN
-            (* the fundamental types are definitely different.  *)
-            RETURN false
-         END
       END
+   ELSIF IsTypeEquivalence (left)
+   THEN
+      RETURN checkPair (result, tinfo, GetDType (left), right)
+   ELSIF IsTypeEquivalence (right)
+   THEN
+      RETURN checkPair (result, tinfo, left, GetDType (right))
    END ;
    RETURN result
 END checkTypeEquivalence ;
@@ -246,13 +304,15 @@ BEGIN
       PushIntegerTree (Mod2Gcc (rLow)) ;
       IF NOT Equ (tinfo^.token)
       THEN
-         RETURN false
+         RETURN falseReason2 ('low values of the subrange types {%1a} {%2a} differ',
+                              tinfo, left, right)
       END ;
       PushIntegerTree (Mod2Gcc (lHigh)) ;
       PushIntegerTree (Mod2Gcc (rHigh)) ;
       IF NOT Equ (tinfo^.token)
       THEN
-         RETURN false
+         RETURN falseReason2 ('high values of the subrange types {%1a} {%2a} differ',
+                              tinfo, left, right)
       END
    END ;
    RETURN true
@@ -266,6 +326,7 @@ END checkSubrange ;
 *)
 
 PROCEDURE checkUnboundedArray (result: status;
+                               tinfo: tInfo;
                                unbounded, array: CARDINAL) : status ;
 VAR
    dim   : CARDINAL ;
@@ -280,13 +341,13 @@ BEGIN
       Assert (IsUnbounded (unbounded)) ;
       Assert (IsArray (array)) ;
       dim := GetDimension (unbounded) ;
-      ubtype := GetType (unbounded) ;
+      ubtype := GetDType (unbounded) ;
       type := array ;
       REPEAT
-         type := GetType (type) ;
+         type := GetDType (type) ;
          DEC (dim) ;
          (* Check type equivalences.  *)
-         IF checkTypeEquivalence (result, type, ubtype) = true
+         IF checkTypeEquivalence (result, tinfo, type, ubtype) = true
          THEN
             RETURN true
          END ;
@@ -294,11 +355,13 @@ BEGIN
          (* If we have run out of dimensions we conclude false.  *)
          IF dim = 0
          THEN
-            RETURN false
+            RETURN falseReason0 ('unbounded array has less dimensions than the array',
+                                 tinfo)
          END ;
       UNTIL NOT IsArray (type)
    END ;
-   RETURN false
+   RETURN falseReason0 ('array has less dimensions than the unbounded array',
+                        tinfo)
 END checkUnboundedArray ;
 
 
@@ -327,14 +390,18 @@ BEGIN
          referenced.  We use GetDimension for 'bar' which is 2.  *)
       IF GetDimension (formal) # GetDimension (tinfo^.actual)
       THEN
-         RETURN false
+         RETURN falseReason2 ('the formal parameter unbounded array {%1a} has a different number' +
+                              '  of dimensions to the actual parameter unbounded array {%2a}',
+                              tinfo, formal, actual)
       END ;
-      IF checkTypeEquivalence (result, GetType (formal), GetType (actual)) = true
+      IF checkTypeEquivalence (result, tinfo, GetType (formal), GetType (actual)) = true
       THEN
          RETURN true
       END
    END ;
-   RETURN false
+   RETURN falseReason2 ('the formal unbounded array type {%1a}' +
+                        ' and the actual unbounded array type {%2a} differ',
+                        tinfo, formal, actual)
 END checkUnboundedUnbounded ;
 
 
@@ -373,10 +440,14 @@ BEGIN
             END
          ELSIF IsArray (right)
          THEN
-            RETURN checkUnboundedArray (result, unbounded, right)
+            RETURN checkUnboundedArray (result, tinfo, unbounded, right)
          ELSIF IsUnbounded (right)
          THEN
             RETURN checkUnboundedUnbounded (result, tinfo, unbounded, right)
+         ELSE
+            RETURN falseReason2 ('the formal unbounded array type {%1a}' +
+                                 ' and the actual unbounded array type {%2a} differ',
+                                 tinfo, unbounded, right)
          END
       END
    END ;
@@ -400,7 +471,7 @@ BEGIN
    THEN
       lSub := GetArraySubscript (left) ;
       rSub := GetArraySubscript (right) ;
-      result := checkPair (result, tinfo, GetSType (left), GetSType (right)) ;
+      result := checkPair (result, tinfo, GetDType (left), GetDType (right)) ;
       IF (lSub # NulSym) AND (rSub # NulSym)
       THEN
          result := checkSubrange (result, tinfo, getSType (lSub), getSType (rSub))
@@ -423,31 +494,58 @@ BEGIN
       END
    ELSIF IsArray (left) AND IsConst (right)
    THEN
-      result := checkPair (result, tinfo, GetType (left), GetType (right))
+      result := checkPair (result, tinfo, GetDType (left), GetDType (right))
    ELSIF IsArray (right) AND IsConst (left)
    THEN
-      result := checkPair (result, tinfo, GetType (left), GetType (right))
+      result := checkPair (result, tinfo, GetDType (left), GetDType (right))
    END ;
    RETURN result
 END checkArrayTypeEquivalence ;
 
 
 (*
-   checkGenericTypeEquivalence - check left and right for generic equivalence.
+   checkCharStringTypeEquivalence - check char and string constants for type equivalence.
 *)
 
-PROCEDURE checkGenericTypeEquivalence (result: status; left, right: CARDINAL) : status ;
+PROCEDURE checkCharStringTypeEquivalence (result: status; tinfo: tInfo;
+                                          left, right: CARDINAL) : status ;
 BEGIN
    IF isFalse (result)
    THEN
       RETURN result
-   ELSIF left = right
+   ELSIF left = Char
    THEN
-      RETURN true
-   ELSE
-      RETURN result
-   END
-END checkGenericTypeEquivalence ;
+      IF IsConst (right)
+      THEN
+         (* We might not know the length of the string yet, in which case we return true.  *)
+         IF IsConstString (right) AND
+            ((NOT GccKnowsAbout (right)) OR (GetStringLength (tinfo^.token, right) <= 1))
+         THEN
+            RETURN true
+         ELSE
+            RETURN falseReason2 ('the string {%2a} does not fit into a {%1a}',
+                                 tinfo, left, right)
+         END
+      ELSIF IsParameter (right)
+      THEN
+         right := GetDType (right) ;
+         IF (right = Char) OR (IsUnbounded (right) AND (SkipType (GetDType (right)) = Char))
+         THEN
+            RETURN true
+         END
+      ELSIF IsArray (right)
+      THEN
+         IF Char = SkipType (GetDType (right))
+         THEN
+            RETURN true
+         END
+      END
+   ELSIF right = Char
+   THEN
+      RETURN checkCharStringTypeEquivalence (result, tinfo, right, left)
+   END ;
+   RETURN result
+END checkCharStringTypeEquivalence ;
 
 
 (*
@@ -491,7 +589,7 @@ BEGIN
    THEN
       IF tinfo^.error = NIL
       THEN
-         (* need to create top level error message first.  *)
+         (* We need to create top level error message first.  *)
          tinfo^.error := NewError (tinfo^.token) ;
          (* The parameters to MetaString4 in buildError4 must match the order
             of paramters passed to ParameterTypeCompatible.  *)
@@ -499,9 +597,17 @@ BEGIN
                            tinfo^.procedure,
                            tinfo^.formal, tinfo^.actual,
                            tinfo^.nth) ;
+         (* Append the overall reason for the failure.  *)
+         IF tinfo^.reason # NIL
+         THEN
+            (* The string tinfo^.reason is given to the error handler.  *)
+            s := ConCat (s, Mark (InitString (" because "))) ;
+            s := ConCat (s, tinfo^.reason) ;
+            tinfo^.reason := NIL   (* Hand over deconstructing to M2MetaError.  *)
+         END ;
          ErrorString (tinfo^.error, s)
       END ;
-      (* and also generate a sub error containing detail.  *)
+      (* And now also generate a sub error containing detail.  *)
       IF (left # tinfo^.left) OR (right # tinfo^.right)
       THEN
          MetaError1 ('formal parameter {%1EDad}', right) ;
@@ -512,7 +618,7 @@ END buildError4 ;
 
 
 (*
-   buildError2 - generate a MetaString2 error.  This is called by all three kinds of errors.
+   buildError2 - generate a MetaString2 error.
 *)
 
 PROCEDURE buildError2 (tinfo: tInfo; left, right: CARDINAL) ;
@@ -543,6 +649,14 @@ BEGIN
                                        left, right)
 
          END ;
+         (* Lastly the overall reason for the failure.  *)
+         IF tinfo^.reason # NIL
+         THEN
+            (* The string tinfo^.reason is given to the error handler.  *)
+            s := ConCat (s, Mark (InitString (" because "))) ;
+            s := ConCat (s, tinfo^.reason) ;
+            tinfo^.reason := NIL   (* Hand over deconstructing to M2MetaError.  *)
+         END ;
          ErrorString (tinfo^.error, s)
       END
    END
@@ -559,7 +673,7 @@ BEGIN
    THEN
       RETURN true
    ELSE
-      (* check whether errors are required.  *)
+      (* Check whether errors are required.  *)
       IF tinfo^.format # NIL
       THEN
          CASE tinfo^.kind OF
@@ -700,11 +814,21 @@ PROCEDURE IsTyped (sym: CARDINAL) : BOOLEAN ;
 BEGIN
    RETURN IsVar (sym) OR IsParameter (sym) OR IsConstructor (sym) OR
           (IsConst (sym) AND IsConstructor (sym)) OR IsParameter (sym) OR
-          (IsConst (sym) AND (GetType (sym) # NulSym))
+          (IsConst (sym) AND (GetDType (sym) # NulSym))
 END IsTyped ;
 
 
 (*
+   IsTypeEquivalence - returns TRUE if sym is a type equivalence symbol.
+*)
+
+PROCEDURE IsTypeEquivalence (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsType (sym) AND (GetDType (sym) # NulSym) AND (GetDType (sym) # sym)
+END IsTypeEquivalence ;
+
+
+(*
    isLValue -
 *)
 
@@ -715,6 +839,38 @@ END isLValue ;
 
 
 (*
+   checkVarTypeEquivalence -
+*)
+
+PROCEDURE checkVarTypeEquivalence (result: status; tinfo: tInfo;
+                                   left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF (left = NulSym) OR (right = NulSym)
+   THEN
+      RETURN true
+   ELSE
+      IF IsVar (left) OR IsVar (right)
+      THEN
+         (* Either left or right will change, so we can call doCheckPair.  *)
+         IF IsVar (left)
+         THEN
+            left := getType (left)
+         END ;
+         IF IsVar (right)
+         THEN
+            right := getType (right)
+         END ;
+         RETURN doCheckPair (result, tinfo, left, right)
+      END
+   END ;
+   RETURN result
+END checkVarTypeEquivalence ;
+
+
+(*
    checkVarEquivalence - this test must be done early as it checks the symbol mode.
                          An LValue is treated as a pointer during assignment and the
                          LValue is attached to a variable.  This function skips the variable
@@ -722,40 +878,44 @@ END isLValue ;
 *)
 
 PROCEDURE checkVarEquivalence (result: status; tinfo: tInfo;
-                               left, right: CARDINAL) : status ;
+                               des, expr: CARDINAL) : status ;
 BEGIN
    IF isFalse (result)
    THEN
       RETURN result
-   ELSIF IsTyped (left) OR IsTyped (right)
+   ELSIF IsTyped (des) OR IsTyped (expr)
    THEN
       IF tinfo^.kind = assignment
       THEN
+         IF GetDType (des) = GetDType (expr)
+         THEN
+            RETURN true
          (* LValues are only relevant during assignment.  *)
-         IF isLValue (left) AND (NOT isLValue (right))
+         ELSIF isLValue (des) AND (NOT isLValue (expr))
          THEN
-            IF SkipType (getType (right)) = Address
+            IF SkipType (getType (expr)) = Address
             THEN
                RETURN true
-            ELSIF IsPointer (SkipType (getType (right)))
+            ELSIF IsPointer (SkipType (getType (expr)))
             THEN
-               right := GetDType (SkipType (getType (right)))
+               expr := GetDType (SkipType (getType (expr))) ;
+               RETURN doCheckPair (result, tinfo, getType (des), expr)
             END
-         ELSIF isLValue (right) AND (NOT isLValue (left))
+         ELSIF isLValue (expr) AND (NOT isLValue (des))
          THEN
-            IF SkipType (getType (left)) = Address
+            IF SkipType (getType (des)) = Address
             THEN
                RETURN true
-            ELSIF IsPointer (SkipType (getType (left)))
+            ELSIF IsPointer (SkipType (getType (des)))
             THEN
-               left := GetDType (SkipType (getType (left)))
+               des := GetDType (SkipType (getType (des))) ;
+               RETURN doCheckPair (result, tinfo, des, getType (expr))
             END
          END
       END ;
-      RETURN doCheckPair (result, tinfo, getType (left), getType (right))
-   ELSE
-      RETURN result
-   END
+      RETURN doCheckPair (result, tinfo, getType (des), getType (expr))
+   END ;
+   RETURN result
 END checkVarEquivalence ;
 
 
@@ -790,10 +950,15 @@ BEGIN
                IsProcedure (typeRight) OR IsRecord (typeRight) OR
                IsReallyPointer (typeRight)
          THEN
-            RETURN false
+            RETURN falseReason1 ('constant string is incompatible with {%1ad}',
+                                 tinfo, typeRight)
          ELSIF IsArray (typeRight)
          THEN
-            RETURN doCheckPair (result, tinfo, Char, GetType (typeRight))
+            RETURN doCheckPair (result, tinfo, Char, GetDType (typeRight))
+         ELSIF NOT GccKnowsAbout (left)
+         THEN
+            (* We do not know the length of this string, so assume true.  *)
+            RETURN true
          ELSIF GetStringLength (tinfo^.token, left) = 1
          THEN
             RETURN doCheckPair (result, tinfo, Char, typeRight)
@@ -803,13 +968,72 @@ BEGIN
    THEN
       typeRight := GetDType (right) ;
       typeLeft := GetDType (left) ;
-      RETURN doCheckPair (result, tinfo, typeLeft, typeRight)
+      IF IsZRCType (typeLeft) AND IsUnbounded (typeRight)
+      THEN
+         RETURN falseReason2 ('the constant {%1a} is incompatible' +
+                              ' with an unbounded array of {%2a}',
+                              tinfo, typeLeft, typeRight)
+      ELSE
+         RETURN doCheckPair (result, tinfo, typeLeft, typeRight)
+      END
    END ;
    RETURN result
 END checkConstMeta ;
 
 
 (*
+   checkEnumField -
+*)
+
+PROCEDURE checkEnumField (result: status; tinfo: tInfo;
+                          left, right: CARDINAL) : status ;
+VAR
+   typeRight: CARDINAL ;
+BEGIN
+   Assert (IsFieldEnumeration (left)) ;
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF IsTyped (right)
+   THEN
+      typeRight := GetDType (right) ;
+      IF typeRight = NulSym
+      THEN
+         RETURN result
+      ELSE
+         RETURN doCheckPair (result, tinfo, GetDType (left), typeRight)
+      END
+   END ;
+   RETURN result
+END checkEnumField ;
+
+
+(*
+   checkEnumFieldEquivalence -
+*)
+
+PROCEDURE checkEnumFieldEquivalence (result: status; tinfo: tInfo;
+                                     left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF (left = NulSym) OR (right = NulSym)
+   THEN
+      (* No option but to return true.  *)
+      RETURN true
+   ELSIF IsFieldEnumeration (left)
+   THEN
+      RETURN checkEnumField (result, tinfo, left, right)
+   ELSIF IsFieldEnumeration (right)
+   THEN
+      RETURN checkEnumField (result, tinfo, right, left)
+   END ;
+   RETURN result
+END checkEnumFieldEquivalence ;
+
+
+(*
    checkConstEquivalence - this check can be done first as it checks symbols which
                            may have no type.  Ie constant strings.  These constants
                            will likely have their type set during quadruple folding.
@@ -856,26 +1080,33 @@ BEGIN
       IF IsSubrange (right)
       THEN
          RETURN doCheckPair (result, tinfo, left, GetDType (right))
-      END ;
-      IF left = right
-      THEN
-         RETURN true
-      ELSE
-         RETURN result
       END
-   END
+   END ;
+   RETURN result
 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 ;
 BEGIN
    IF IsConst (sym)
    THEN
-      sym := SkipType (GetType (sym))
+      sym := SkipType (GetDType (sym))
    END ;
    IF (zrc = CType) AND (IsComplexN (sym) OR IsComplexType (sym))
    THEN
@@ -894,11 +1125,11 @@ PROCEDURE isSameSizeConst (a, b: CARDINAL) : BOOLEAN ;
 BEGIN
    IF IsConst (a)
    THEN
-      a := SkipType (GetType (a)) ;
+      a := SkipType (GetDType (a)) ;
       RETURN isZRC (a, b) OR (a = b) OR ((a # NulSym) AND isSameSize (a, b))
    ELSIF IsConst (b)
    THEN
-      b := SkipType (GetType (b)) ;
+      b := SkipType (GetDType (b)) ;
       RETURN isZRC (b, a) OR (a = b) OR ((b # NulSym) AND isSameSize (a, b))
    END ;
    RETURN FALSE
@@ -919,13 +1150,15 @@ END isSameSize ;
    checkSystemEquivalence - check whether left and right are system types and whether they have the same size.
 *)
 
-PROCEDURE checkSystemEquivalence (result: status; left, right: CARDINAL) : status ;
+PROCEDURE checkSystemEquivalence (result: status; tinfo: tInfo <* unused *>;
+                                  left, right: CARDINAL) : status ;
 BEGIN
    IF isFalse (result) OR (result = visited)
    THEN
       RETURN result
    ELSE
       IF (IsGenericSystemType (left) OR IsGenericSystemType (right)) AND
+         GccKnowsAbout (left) AND GccKnowsAbout (right) AND
          isSameSize (left, right)
       THEN
          RETURN true
@@ -940,7 +1173,7 @@ END checkSystemEquivalence ;
                             a set, record or array.
 *)
 
-PROCEDURE checkTypeKindViolation (result: status;
+PROCEDURE checkTypeKindViolation (result: status; tinfo: tInfo;
                                   left, right: CARDINAL) : status ;
 BEGIN
    IF isFalse (result) OR (result = visited)
@@ -952,7 +1185,8 @@ BEGIN
          (IsRecord (left) OR IsRecord (right)) OR
          (IsArray (left) OR IsArray (right))
       THEN
-         RETURN false
+         RETURN falseReason2 ('a {%1ad} is incompatible with a {%2ad}',
+                              tinfo, left, right)
       END
    END ;
    RETURN result
@@ -960,7 +1194,7 @@ END checkTypeKindViolation ;
 
 
 (*
-   doCheckPair - invoke a series of ordered type checks checking compatibility
+   doCheckPair - invoke a series of type checks checking compatibility
                  between left and right modula2 symbols.
                  Pre-condition: left and right are modula-2 symbols.
                                 tinfo is configured.
@@ -972,50 +1206,28 @@ END checkTypeKindViolation ;
 
 PROCEDURE doCheckPair (result: status; tinfo: tInfo;
                        left, right: CARDINAL) : status ;
+VAR
+   i: CARDINAL ;
 BEGIN
-   IF isFalse (result) OR (result = visited)
+   IF (left = NulSym) OR (right = NulSym)
+   THEN
+      (* We cannot check NulSym.  *)
+      RETURN true
+   ELSIF isKnown (result)
    THEN
       RETURN return (result, tinfo, left, right)
    ELSIF left = right
    THEN
       RETURN return (true, tinfo, left, right)
    ELSE
-      result := checkConstEquivalence (unknown, tinfo, left, right) ;
-      IF NOT isKnown (result)
-      THEN
-         result := checkVarEquivalence (unknown, tinfo, left, right) ;
-         IF NOT isKnown (result)
+      i := 1 ;
+      WHILE i <= HighEquivalence DO
+         result := Equivalence[i] (result, tinfo, left, right) ;
+         IF isKnown (result)
          THEN
-            result := checkSystemEquivalence (unknown, left, right) ;
-            IF NOT isKnown (result)
-            THEN
-               result := checkSubrangeTypeEquivalence (unknown, tinfo, left, right) ;
-               IF NOT isKnown (result)
-               THEN
-                  result := checkBaseTypeEquivalence (unknown, tinfo, left, right) ;
-                  IF NOT isKnown (result)
-                  THEN
-                     result := checkTypeEquivalence (unknown, left, right) ;
-                     IF NOT isKnown (result)
-                     THEN
-                        result := checkArrayTypeEquivalence (result, tinfo, left, right) ;
-                        IF NOT isKnown (result)
-                        THEN
-                           result := checkGenericTypeEquivalence (result, left, right) ;
-                           IF NOT isKnown (result)
-                           THEN
-                              result := checkTypeKindEquivalence (result, tinfo, left, right) ;
-                              IF NOT isKnown (result)
-                              THEN
-                                 result := checkTypeKindViolation (result, left, right)
-                              END
-                           END
-                        END
-                     END
-                  END
-               END
-            END
-         END
+            RETURN return (result, tinfo, left, right)
+         END ;
+         INC (i)
       END
    END ;
    RETURN return (result, tinfo, left, right)
@@ -1023,6 +1235,45 @@ END doCheckPair ;
 
 
 (*
+   InitEquivalenceArray - populate the Equivalence array with the
+                          checking procedures.
+*)
+
+PROCEDURE InitEquivalenceArray ;
+BEGIN
+   HighEquivalence := 0 ;
+   addEquivalence (checkVarEquivalence) ;
+   addEquivalence (checkVarTypeEquivalence) ;
+   addEquivalence (checkCharStringTypeEquivalence) ;
+   addEquivalence (checkConstEquivalence);
+   addEquivalence (checkEnumFieldEquivalence) ;
+   addEquivalence (checkSystemEquivalence) ;
+   addEquivalence (checkSubrangeTypeEquivalence) ;
+   addEquivalence (checkBaseTypeEquivalence) ;
+   addEquivalence (checkTypeEquivalence) ;
+   addEquivalence (checkArrayTypeEquivalence) ;
+   addEquivalence (checkTypeKindEquivalence) ;
+   addEquivalence (checkTypeKindViolation)
+END InitEquivalenceArray ;
+
+
+(*
+   addEquivalence - places proc into Equivalence array.
+*)
+
+PROCEDURE addEquivalence (proc: EquivalenceProcedure) ;
+BEGIN
+   INC (HighEquivalence) ;
+   IF HighEquivalence <= MaxEquvalence
+   THEN
+      Equivalence[HighEquivalence] := proc
+   ELSE
+      InternalError ('increase MaxEquivalence constant in M2Check.mod')
+   END
+END addEquivalence ;
+
+
+(*
    checkProcType -
 *)
 
@@ -1073,6 +1324,12 @@ BEGIN
       i := 1 ;
       n := NoOfParamAny (left) ;
       WHILE i <= n DO
+         IF isFalse (result) OR (result = visited)
+         THEN
+            (* Seen a mismatch therefore return.  *)
+            RETURN return (result, tinfo, left, right)
+         END ;
+         result := unknown ;   (* Each parameter must match.  *)
          IF IsVarParamAny (left, i) # IsVarParamAny (right, i)
          THEN
             IF IsVarParamAny (left, i)
@@ -1264,7 +1521,6 @@ BEGIN
 END checkProcTypeEquivalence ;
 
 
-
 (*
    checkTypeKindEquivalence -
 *)
@@ -1534,7 +1790,7 @@ BEGIN
    THEN
       RETURN Address
    ELSE
-      RETURN GetSType (sym)
+      RETURN GetDType (sym)
    END
 END getSType ;
 
@@ -1610,11 +1866,19 @@ BEGIN
          printf ("doCheck (%d, %d)\n", left, right) ;
          dumptInfo (tinfo)
       END ;
-      IF isInternal (left) OR isInternal (right)
+      IF (left = NulSym) OR (right = NulSym)
+      THEN
+         (* Cannot test if a type is NulSym, we assume true.
+            It maybe that later on a symbols type is set and later
+            on checking will be called and more accurately resolved.
+            For example constant strings can be concatenated during
+            the quadruple folding phase.  *)
+         RETURN TRUE
+      ELSIF isInternal (left) OR isInternal (right)
       THEN
          (* Do not check constants which have been generated internally.
-            Currently these are generated by the default BY constant value
-            in a FOR loop.  *)
+            Currently these are generated by the default BY constant
+            value in a FOR loop.  *)
          RETURN TRUE
       END ;
       (*
@@ -1633,9 +1897,9 @@ BEGIN
       result := tinfo^.checkFunc (unknown, tinfo, left, right) ;
       IF isKnown (result)
       THEN
-         (* remove this pair from the unresolved list.  *)
+         (* Remove this pair from the unresolved list.  *)
          exclude (tinfo^.unresolved, left, right) ;
-         (* add it to the resolved list.  *)
+         (* Add it to the resolved list.  *)
          include (tinfo^.resolved, left, right, result) ;
          IF result = false
          THEN
@@ -1740,6 +2004,7 @@ END deconstructIndex ;
 PROCEDURE deconstruct (tinfo: tInfo) ;
 BEGIN
    tinfo^.format := KillString (tinfo^.format) ;
+   tinfo^.reason := KillString (tinfo^.reason) ;
    tinfo^.visited := deconstructIndex (tinfo^.visited) ;
    tinfo^.resolved := deconstructIndex (tinfo^.resolved) ;
    tinfo^.unresolved := deconstructIndex (tinfo^.unresolved)
@@ -1786,11 +2051,14 @@ END collapseString ;
 *)
 
 PROCEDURE AssignmentTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
-                                    des, expr: CARDINAL) : BOOLEAN ;
+                                    des, expr: CARDINAL;
+                                    enableReason: BOOLEAN) : BOOLEAN ;
 VAR
    tinfo: tInfo ;
 BEGIN
    tinfo := newtInfo () ;
+   tinfo^.reason := NIL ;
+   tinfo^.reasonEnable := enableReason AND StrictTypeReason ;
    tinfo^.format := collapseString (format) ;
    tinfo^.token := token ;
    tinfo^.kind := assignment ;
@@ -1835,6 +2103,8 @@ BEGIN
    tinfo := newtInfo () ;
    formalT := getSType (formal) ;
    actualT := getSType (actual) ;
+   tinfo^.reasonEnable := StrictTypeReason ;
+   tinfo^.reason := NIL ;
    tinfo^.format := collapseString (format) ;
    tinfo^.token := token ;
    tinfo^.kind := parameter ;
@@ -1879,6 +2149,8 @@ VAR
    tinfo: tInfo ;
 BEGIN
    tinfo := newtInfo () ;
+   tinfo^.reasonEnable := StrictTypeReason ;
+   tinfo^.reason := NIL ;
    tinfo^.format := collapseString (format) ;
    tinfo^.token := token ;
    tinfo^.kind := expression ;
@@ -1943,7 +2215,8 @@ PROCEDURE init ;
 BEGIN
    pairFreeList  := NIL ;
    tinfoFreeList := NIL ;
-   errors        := InitIndex (1)
+   errors        := InitIndex (1) ;
+   InitEquivalenceArray
 END init ;
 
 
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.def b/gcc/m2/gm2-compiler/M2GCCDeclare.def
index 1d87d6b..b3a5790 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.def
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.def
@@ -98,7 +98,7 @@ PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
                     then enter it into the to do list.
 *)
 
-PROCEDURE TryDeclareType (tokenno: CARDINAL; type: CARDINAL) ;
+PROCEDURE TryDeclareType (type: CARDINAL) ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 7dcf439..860a89a 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -144,7 +144,7 @@ FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction,
                    Boolean, True, False, Nil,
                    IsRealType, IsNeededAtRunTime, IsComplexType ;
 
-FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType,
+FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType, IsRealN,
                      GetSystemTypeMinMax, Address, Word, Byte, Loc,
                      System, IntegerN, CardinalN, WordN, RealN, SetN, ComplexN,
 		     CSizeT, CSSizeT, COffT ;
@@ -251,6 +251,7 @@ TYPE
 VAR
    FreeGroup,
    GlobalGroup         : Group ;    (* The global group of all sets.  *)
+   ErrorDepList,       (* The set of symbols with dependency errors.  *)
    VisitedList,
    ChainedList         : Set ;
    HaveInitDefaultTypes: BOOLEAN ;  (* Have we initialized them yet?  *)
@@ -261,9 +262,6 @@ VAR
    enumDeps            : BOOLEAN ;
 
 
-PROCEDURE mystop ; BEGIN END mystop ;
-
-
 (* *************************************************** *)
 (*
    PrintNum -
@@ -1315,14 +1313,26 @@ END CanBeDeclaredPartiallyViaPartialDependants ;
 
 
 (*
-   EmitCircularDependancyError - issue a dependancy error.
+   EmitCircularDependencyError - issue a dependency error.
 *)
 
-PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ;
+PROCEDURE EmitCircularDependencyError (sym: CARDINAL) ;
 BEGIN
-   MetaError1('circular dependancy error found when trying to resolve {%1Uad}',
-              sym)
-END EmitCircularDependancyError ;
+   (* Ensure we only issue one dependency message per symbol for this
+      error classification.  *)
+   IF NOT IsElementInSet (ErrorDepList, sym)
+   THEN
+      IncludeElementIntoSet (ErrorDepList, sym) ;
+      IF IsVar (sym) OR IsParameter (sym)
+      THEN
+         MetaError1 ('circular dependency error found when trying to resolve {%1Had}',
+                     sym)
+      ELSE
+         MetaError1 ('circular dependency error found when trying to resolve {%1Dad}',
+                     sym)
+      END
+   END
+END EmitCircularDependencyError ;
 
 
 TYPE
@@ -1529,17 +1539,17 @@ BEGIN
       IF ForeachTryDeclare (todolist,
                             circulartodo,
                             NotAllDependantsFullyDeclared,
-                            EmitCircularDependancyError)
+                            EmitCircularDependencyError)
       THEN
       ELSIF ForeachTryDeclare (partiallydeclared,
                                circularpartial,
                                NotAllDependantsPartiallyDeclared,
-                               EmitCircularDependancyError)
+                               EmitCircularDependencyError)
       THEN
       ELSIF ForeachTryDeclare (niltypedarrays,
                                circularniltyped,
                                NotAllDependantsPartiallyDeclared,
-                               EmitCircularDependancyError)
+                               EmitCircularDependencyError)
       THEN
       END
    END ;
@@ -1918,7 +1928,7 @@ END IsAnyType ;
                     then enter it into the to do list.
 *)
 
-PROCEDURE TryDeclareType (tokenno: CARDINAL; type: CARDINAL) ;
+PROCEDURE TryDeclareType (type: CARDINAL) ;
 BEGIN
    IF (type#NulSym) AND IsAnyType (type)
    THEN
@@ -2013,7 +2023,7 @@ BEGIN
          ELSIF IsConstructor(sym)
          THEN
             DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
-         ELSIF IsRealType(GetDType(sym))
+         ELSIF IsRealType (GetDType (sym)) OR IsRealN (GetDType (sym))
          THEN
             type := GetDType(sym) ;
             DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE))
@@ -2855,13 +2865,8 @@ BEGIN
    n := 1 ;
    Var := GetNth(scope, n) ;
    WHILE Var#NulSym DO
-      IF NOT AllDependantsFullyDeclared(GetSType(Var))
-      THEN
-         mystop
-      END ;
-      IF NOT AllDependantsFullyDeclared(GetSType(Var))
+      IF NOT TypeDependentsDeclared (Var, TRUE)
       THEN
-         EmitCircularDependancyError(GetSType(Var)) ;
          failed := TRUE
       END ;
       INC(n) ;
@@ -2922,14 +2927,12 @@ BEGIN
       DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo  *)
                                                (* lists.                                      *)
       ForeachModuleDo(DeclareProcedure) ;
-      (*
-         now that all types have been resolved it is safe to declare
-         variables
-      *)
+      (* Now that all types have been resolved it is safe to declare
+         variables.  *)
       AssertAllTypesDeclared(scope) ;
       DeclareGlobalVariables(scope) ;
       ForeachImportedDo(scope, DeclareImportedVariables) ;
-      (* now it is safe to declare all procedures *)
+      (* Now it is safe to declare all procedures.  *)
       ForeachProcedureDo(scope, DeclareProcedure) ;
       ForeachInnerModuleDo(scope, WalkTypesInModule) ;
       ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
@@ -2958,14 +2961,12 @@ BEGIN
                                                (* lists.                                      *)
       ForeachModuleDo(DeclareProcedure) ;
       ForeachModuleDo(DeclareModuleInit) ;
-      (*
-         now that all types have been resolved it is safe to declare
-         variables
-      *)
+      (* Now that all types have been resolved it is safe to declare
+         variables.  *)
       AssertAllTypesDeclared(scope) ;
       DeclareGlobalVariablesWholeProgram(scope) ;
       ForeachImportedDo(scope, DeclareImportedVariablesWholeProgram) ;
-      (* now it is safe to declare all procedures *)
+      (* Now it is safe to declare all procedures.  *)
       ForeachProcedureDo(scope, DeclareProcedure) ;
       ForeachInnerModuleDo(scope, WalkTypesInModule) ;
       ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
@@ -3411,15 +3412,55 @@ PROCEDURE DoVariableDeclaration (var: CARDINAL; name: ADDRESS;
                                  isImported, isExported,
                                  isTemporary, isGlobal: BOOLEAN;
                                  scope: tree) ;
+BEGIN
+   IF NOT (IsComponent (var) OR IsVarHeap (var))
+   THEN
+      IF TypeDependentsDeclared (var, TRUE)
+      THEN
+         PrepareGCCVarDeclaration (var, name, isImported, isExported,
+                                   isTemporary, isGlobal, scope)
+      END
+   END
+END DoVariableDeclaration ;
+
+
+(*
+   TypeDependentsDeclared - return TRUE if all type dependents of variable
+                            have been declared.
+*)
+
+PROCEDURE TypeDependentsDeclared (variable: CARDINAL; errorMessage: BOOLEAN) : BOOLEAN ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := GetSType (variable) ;
+   IF AllDependantsFullyDeclared (type)
+   THEN
+      RETURN TRUE
+   ELSE
+      IF errorMessage
+      THEN
+         EmitCircularDependencyError (variable) ;
+         ForeachElementInSetDo (GlobalGroup^.ToDoList, EmitCircularDependencyError)
+      END
+   END ;
+   RETURN FALSE
+END TypeDependentsDeclared ;
+
+
+(*
+   PrepareGCCVarDeclaration -
+*)
+
+PROCEDURE PrepareGCCVarDeclaration (var: CARDINAL; name: ADDRESS;
+                                    isImported, isExported,
+                                    isTemporary, isGlobal: BOOLEAN;
+                                    scope: tree) ;
 VAR
    type    : tree ;
    varType : CARDINAL ;
    location: location_t ;
 BEGIN
-   IF IsComponent (var) OR IsVarHeap (var)
-   THEN
-      RETURN
-   END ;
    IF GetMode (var) = LeftValue
    THEN
       (*
@@ -3457,7 +3498,7 @@ BEGIN
                                             isGlobal, scope, NIL)) ;
    WatchRemoveList (var, todolist) ;
    WatchIncludeList (var, fullydeclared)
-END DoVariableDeclaration ;
+END PrepareGCCVarDeclaration ;
 
 
 (*
@@ -3493,7 +3534,6 @@ BEGIN
    THEN
       scope := FindContext (ModSym) ;
       decl := FindOuterModule (variable) ;
-      Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
       PushBinding (ModSym) ;
       DoVariableDeclaration (variable,
                              KeyToCharStar (GetFullSymName (variable)),
@@ -3521,7 +3561,6 @@ BEGIN
    THEN
       scope := FindContext (mainModule) ;
       decl := FindOuterModule (variable) ;
-      Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
       PushBinding (mainModule) ;
       DoVariableDeclaration (variable,
                              KeyToCharStar (GetFullSymName (variable)),
@@ -3618,7 +3657,6 @@ END DeclareImportedVariablesWholeProgram ;
 
 PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
 BEGIN
-   Assert (AllDependantsFullyDeclared (var)) ;
    DoVariableDeclaration (var,
                           KeyToCharStar (GetFullSymName (var)),
                           FALSE,  (* local variables cannot be imported *)
@@ -3662,7 +3700,6 @@ BEGIN
    scope := Mod2Gcc (GetProcedureScope (sym)) ;
    Var := GetNth (sym, i) ;
    WHILE Var # NulSym DO
-      Assert (AllDependantsFullyDeclared (GetSType (Var))) ;
       DoVariableDeclaration (Var,
                              KeyToCharStar (GetFullSymName (Var)),
                              FALSE,   (* inner module variables cannot be imported *)
@@ -6658,6 +6695,7 @@ END InitDeclarations ;
 BEGIN
    FreeGroup := NIL ;
    GlobalGroup := InitGroup () ;
+   ErrorDepList := InitSet (1) ;
    ChainedList := InitSet(1) ;
    WatchList := InitSet(1) ;
    VisitedList := NIL ;
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index ec38dc2..4a9ced3 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -43,7 +43,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
                         IsConst, IsConstSet, IsProcedure, IsProcType,
                         IsVar, IsVarParamAny, IsTemporary, IsTuple,
                         IsEnumeration,
-                        IsUnbounded, IsArray, IsSet, IsConstructor,
+                        IsUnbounded, IsArray, IsSet, IsConstructor, IsConstructorConstant,
                         IsProcedureVariable,
                         IsUnboundedParamAny,
                         IsRecordField, IsFieldVarient, IsVarient, IsRecord,
@@ -232,7 +232,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunct
                         BuildReturnValueCode, SetLastFunction,
                         BuildIncludeVarConst, BuildIncludeVarVar,
                         BuildExcludeVarConst, BuildExcludeVarVar,
-                        BuildBuiltinCallTree,
+                        BuildBuiltinCallTree, CopyByField,
 			GetParamTree, BuildCleanUp,
 			BuildTryFinally,
 			GetLastFunction, SetLastFunction,
@@ -241,7 +241,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunct
 FROM m2type IMPORT ChainOnParamValue, GetPointerType, GetIntegerType, AddStatement,
                    GetCardinalType, GetWordType, GetM2ZType, GetM2RType, GetM2CType,
                    BuildCharConstant, AddStringToTreeList, BuildArrayStringConstructor,
-                   GetArrayNoOfElements, GetTreeType ;
+                   GetArrayNoOfElements, GetTreeType, IsGccStrictTypeEquivalent ;
 
 FROM m2block IMPORT RememberConstant, pushGlobalScope, popGlobalScope, finishFunctionDecl,
                     pushFunctionScope, popFunctionScope,
@@ -681,7 +681,7 @@ BEGIN
    IfGreOp            : CodeIfGre (q) |
    IfInOp             : CodeIfIn (q) |
    IfNotInOp          : CodeIfNotIn (q) |
-   IndrXOp            : CodeIndrX (q, op1, op2, op3) |
+   IndrXOp            : CodeIndrX (q) |
    XIndrOp            : CodeXIndr (q) |
    CallOp             : CodeCall (CurrentQuadToken, op3) |
    ParamOp            : CodeParam (q) |
@@ -2914,9 +2914,6 @@ BEGIN
          IF TypeCheckBecomes (p, quad)
          THEN
             PerformFoldBecomes (p, quad)
-         ELSE
-            GetQuad (quad, op, des, op2, expr) ;
-            RemoveQuad (p, des, quad)
          END
       END
    END
@@ -3007,7 +3004,7 @@ BEGIN
                 despos, op2pos, exprpos) ;
    Assert (op2pos = UnknownTokenNo) ;
    IF StrictTypeChecking AND
-      (NOT AssignmentTypeCompatible (despos, "", des, expr))
+      (NOT AssignmentTypeCompatible (despos, "", des, expr, TRUE))
    THEN
       MetaErrorT2 (MakeVirtualTok (becomespos, despos, exprpos),
                    'assignment check caught mismatch between {%1Ead} and {%2ad}',
@@ -3236,7 +3233,7 @@ BEGIN
       IF SkipType(GetTypeMode(op1))#SkipType(GetTypeMode(op3))
       THEN
          DescribeTypeError (tokenno, op1, op3) ;
-         (* Assigning an errant op3 might ICE, therefore it is safer to return op1.  *)         
+         (* Assigning an errant op3 might ICE, therefore it is safer to return op1.  *)
          RETURN( Mod2Gcc (op1) )
       END
    END ;
@@ -3498,6 +3495,29 @@ END checkDeclare ;
 
 
 (*
+   PerformCodeBecomes -
+*)
+
+PROCEDURE PerformCodeBecomes (location: location_t;
+                              virtpos: CARDINAL; des, expr: CARDINAL) ;
+VAR
+   destree, exprtree: tree ;
+BEGIN
+   destree := Mod2Gcc (des) ;
+   exprtree := FoldConstBecomes (virtpos, des, expr) ;
+   IF IsVar (des) AND IsVariableSSA (des)
+   THEN
+      Replace (des, exprtree)
+   ELSIF IsGccStrictTypeEquivalent (destree, exprtree)
+   THEN
+      BuildAssignmentStatement (location, destree, exprtree)
+   ELSE
+      CopyByField (location, destree, exprtree)
+   END
+END PerformCodeBecomes ;
+
+
+(*
 ------------------------------------------------------------------------------
    := Operator
 ------------------------------------------------------------------------------
@@ -3530,7 +3550,7 @@ BEGIN
    location := TokenToLocation (virtpos) ;
 
    IF StrictTypeChecking AND
-      (NOT AssignmentTypeCompatible (virtpos, "", des, expr))
+      (NOT AssignmentTypeCompatible (virtpos, "", des, expr, TRUE))
    THEN
       ErrorMessageDecl (virtpos,
                         'assignment check caught mismatch between {%1Ead} and {%2ad}',
@@ -3576,14 +3596,7 @@ BEGIN
       ELSE
          IF checkBecomes (des, expr, virtpos, despos, exprpos)
          THEN
-            IF IsVar (des) AND IsVariableSSA (des)
-            THEN
-               Replace (des, FoldConstBecomes (virtpos, des, expr))
-            ELSE
-               BuildAssignmentStatement (location,
-                                         Mod2Gcc (des),
-                                         FoldConstBecomes (virtpos, des, expr))
-            END
+            PerformCodeBecomes (location, virtpos, des, expr)
          ELSE
             SubQuad (quad)  (* We don't want multiple errors for the quad.  *)
          END
@@ -3905,8 +3918,6 @@ END NoWalkProcedure ;
 
 PROCEDURE CheckBinaryExpressionTypes (quad: CARDINAL; p: WalkAction) : BOOLEAN ;
 VAR
-   lefttype,
-   righttype,
    des, left, right: CARDINAL ;
    typeChecking,
    constExpr,
@@ -3924,10 +3935,8 @@ BEGIN
    IF typeChecking AND (op # LogicalRotateOp) AND (op # LogicalShiftOp)
    THEN
       subexprpos := MakeVirtualTok (operatorpos, leftpos, rightpos) ;
-      lefttype := GetType (left) ;
-      righttype := GetType (right) ;
       IF StrictTypeChecking AND
-         (NOT ExpressionTypeCompatible (subexprpos, "", lefttype, righttype,
+         (NOT ExpressionTypeCompatible (subexprpos, "", left, right,
                                         StrictTypeChecking, FALSE))
       THEN
          MetaErrorT2 (subexprpos,
@@ -3937,19 +3946,6 @@ BEGIN
          SubQuad (quad) ;
          p (des) ;
          RETURN FALSE
-      END ;
-      (* --fixme-- the ExpressionTypeCompatible above should be enough
-         and the code below can be removed once ExpressionTypeCompatible
-         is bug free.  *)
-      IF NOT IsExpressionCompatible (lefttype, righttype)
-      THEN
-         ErrorMessageDecl (subexprpos,
-                           'expression mismatch between {%1Etad} and {%2tad}',
-                           left, right, TRUE) ;
-         NoChange := FALSE ;
-         SubQuad (quad) ;
-         p (des) ;
-         RETURN FALSE
       END
    END ;
    RETURN TRUE
@@ -3965,7 +3961,6 @@ END CheckBinaryExpressionTypes ;
 
 PROCEDURE CheckElementSetTypes (quad: CARDINAL) : BOOLEAN ;
 VAR
-   lefttype,
    righttype,
    ignore, left, right: CARDINAL ;
    constExpr,
@@ -3982,13 +3977,9 @@ BEGIN
                 overflowChecking, constExpr,
                 leftpos, rightpos, ignorepos) ;
    subexprpos := MakeVirtualTok (operatorpos, leftpos, rightpos) ;
-   lefttype := GetType (left) ;
    righttype := GetType (right) ;
-   (* --fixme-- the ExpressionTypeCompatible below does not always catch
-      type errors, it needs to be fixed and then some of the subsequent tests
-      can be removed (and/or this procedure function rewritten).  *)
    IF StrictTypeChecking AND
-      (NOT ExpressionTypeCompatible (subexprpos, "", lefttype, righttype,
+      (NOT ExpressionTypeCompatible (subexprpos, "", left, right,
                                      StrictTypeChecking, TRUE))
    THEN
       MetaErrorT2 (subexprpos,
@@ -4007,17 +3998,6 @@ BEGIN
       SubQuad (quad) ;
       RETURN FALSE
    END ;
-   righttype := GetType (SkipType (righttype)) ;
-   (* Now fall though and compare the set element left against the type of set righttype.  *)
-   IF NOT IsExpressionCompatible (lefttype, righttype)
-   THEN
-      ErrorMessageDecl (subexprpos,
-                        'the types used in expression {%1Etad} {%kIN} {%2tad} are incompatible',
-                        left, right, TRUE) ;
-      NoChange := FALSE ;
-      SubQuad (quad) ;
-      RETURN FALSE
-   END ;
    RETURN TRUE
 END CheckElementSetTypes ;
 
@@ -4821,18 +4801,17 @@ END FoldBuiltinTypeInfo ;
 
 PROCEDURE FoldTBitsize  (tokenno: CARDINAL; p: WalkAction;
                          quad: CARDINAL;
-                         op1, op2, op3: CARDINAL) ;
+                         res, type: CARDINAL) ;
 VAR
-   type    : CARDINAL ;
    location: location_t ;
 BEGIN
    location := TokenToLocation(tokenno) ;
-   TryDeclareType (tokenno, op3) ;
-   type := GetDType (op3) ;
+   TryDeclareType (type) ;
+   type := GetDType (type) ;
    IF CompletelyResolved (type)
    THEN
-      AddModGcc (op1, BuildSystemTBitSize (location, Mod2Gcc (type))) ;
-      p (op1) ;
+      AddModGcc (res, BuildSystemTBitSize (location, Mod2Gcc (type))) ;
+      p (res) ;
       NoChange := FALSE ;
       SubQuad (quad)
    END
@@ -4971,7 +4950,7 @@ BEGIN
       END
    ELSIF op2=TBitSize
    THEN
-      FoldTBitsize (tokenno, p, quad, op1, op2, op3)
+      FoldTBitsize (tokenno, p, quad, op1, op3)
    ELSE
       InternalError ('only expecting LENGTH, CAP, ABS, IM, RE')
    END
@@ -8162,25 +8141,52 @@ END CodeIfNotIn ;
    (op2 is the type of the data being indirectly copied)
 *)
 
-PROCEDURE CodeIndrX (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE CodeIndrX (quad: CARDINAL) ;
 VAR
-   location: location_t ;
+   constExpr,
+   overflowChecking: BOOLEAN ;
+   op              : QuadOperator ;
+   tokenno,
+   left,
+   type,
+   right,
+   leftpos,
+   rightpos,
+   typepos,
+   indrxpos        : CARDINAL ;
+   length,
+   newstr          : tree ;
+   location        : location_t ;
 BEGIN
-   location := TokenToLocation (CurrentQuadToken) ;
+   GetQuadOtok (quad, indrxpos, op, left, type, right,
+                overflowChecking, constExpr,
+                leftpos, typepos, rightpos) ;
+   tokenno := MakeVirtualTok (indrxpos, leftpos, rightpos) ;
+   location := TokenToLocation (tokenno) ;
 
    (*
       Follow the Quadruple rules:
    *)
-   DeclareConstant (CurrentQuadToken, op3) ;  (* checks to see whether it is a constant and declares it *)
-   DeclareConstructor (CurrentQuadToken, quad, op3) ;
-   IF IsConstString (op3)
+   DeclareConstant (rightpos, right) ;  (* Checks to see whether it is a constant
+                                           and if necessary declare it.  *)
+   DeclareConstructor (rightpos, quad, right) ;
+   IF IsConstString (right)
    THEN
       InternalError ('not expecting to index through a constant string')
+   ELSIF StrictTypeChecking AND
+      (NOT AssignmentTypeCompatible (indrxpos, "", left, GetType (right), TRUE))
+   THEN
+      MetaErrorT2 (tokenno,
+                   'assignment check caught mismatch between {%1Ead} and {%2ad}',
+                   left, right) ;
+      SubQuad (quad)
    ELSE
+
       (*
          Mem[op1] := Mem[Mem[op3]]
       *)
-      BuildAssignmentStatement (location, Mod2Gcc (op1), BuildIndirect (location, Mod2Gcc (op3), Mod2Gcc (op2)))
+      BuildAssignmentStatement (location, Mod2Gcc (left),
+                                BuildIndirect (location, Mod2Gcc (right), Mod2Gcc (type)))
    END
 END CodeIndrX ;
 
@@ -8217,6 +8223,14 @@ BEGIN
    type := SkipType (type) ;
    DeclareConstant (rightpos, right) ;
    DeclareConstructor (rightpos, quad, right) ;
+   IF StrictTypeChecking AND
+      (NOT AssignmentTypeCompatible (xindrpos, "", GetType (left), right, TRUE))
+   THEN
+      MetaErrorT2 (tokenno,
+                   'assignment check caught mismatch between {%1Ead} and {%2ad}',
+                   left, right) ;
+      SubQuad (quad)
+   END ;
    IF IsProcType(SkipType(type))
    THEN
       BuildAssignmentStatement (location, BuildIndirect (location, Mod2Gcc (left), GetPointerType ()), Mod2Gcc (right))
diff --git a/gcc/m2/gm2-compiler/M2MetaError.def b/gcc/m2/gm2-compiler/M2MetaError.def
index 637a27d..3dfe9fa 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.def
+++ b/gcc/m2/gm2-compiler/M2MetaError.def
@@ -73,7 +73,8 @@ FROM NameKey IMPORT Name ;
     {%kword}  the string word is unquoted and rendered as a keyword.
     {%C}      chain this error on the previous rooted error.
     {%R}      this error will be the root of the future chained errors.
-    {%n}      decimal number.  Not quoted.
+    {% n}     decimal number.  Not quoted.  There is no space between the
+              % and n (this has been added to hide this comment from gettext).
     {%N}      count (number), for example, 1st, 2nd, 3rd, 4th.  Not quoted.
     {%X}      push contents of the output string onto the string stack.
     {%Yname}  place contents of dictionary entry name onto the output string.
@@ -92,9 +93,9 @@ FROM NameKey IMPORT Name ;
     %}        }
     the error messages may also embed optional strings such as:
 
-    {%1a:this string is emitted if the symbol name is non null}
-    {!%1a:this string is emitted if the symbol name is null}
-    {!%1a:{%1d}}
+    {%1a:this string is emitted if the symbol name is null}
+    {!%1a:this string is emitted if the symbol name is non null}
+    {%1a:{%1d}}
            if the symbol name does not exist then print a description
            of the symbol.
     {%1atd} was incompatible with the return type of the procedure
@@ -109,7 +110,8 @@ FROM NameKey IMPORT Name ;
     describe the symbol.  If ordinary text is copied then it is not quoted.
 
    The color strings are: "filename", "quote", "error", "warning", "note",
-                          "locus", "insert", "delete", "type", "range1", range2".
+                          "locus", "insert", "delete", "type", "range1",
+                          "range2".
 *)
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 22bc77f..3aa7543 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -1437,35 +1437,22 @@ BEGIN
       doError (eb, GetDeclaredDef (sym))
    ELSE
       M2Error.EnterErrorScope (GetErrorScope (scope)) ;
-      IF IsProcedure (scope)
+      IF IsVar (sym) OR IsParameter (sym)
       THEN
-         IF IsVar (sym) OR IsParameter (sym)
-         THEN
-            doError (eb, GetVarParamTok (sym))
-         ELSE
-            doError (eb, GetDeclaredDef (sym))
-         END
+         doError (eb, GetVarParamTok (sym))
+      ELSIF IsProcedure (scope)
+      THEN
+         doError (eb, GetDeclaredDef (sym))
+      ELSIF IsModule (scope)
+      THEN
+         doError (eb, GetDeclaredMod (sym))
       ELSE
-         IF IsModule (scope)
+         Assert (IsDefImp (scope)) ;
+         IF GetDeclaredDefinition (sym) = UnknownTokenNo
          THEN
-            IF IsInnerModule (scope)
-            THEN
-               doError (eb, GetDeclaredDef (sym))
-            ELSE
-               doError (eb, GetDeclaredDef (sym))
-            END
+            doError (eb, GetDeclaredMod (sym))
          ELSE
-            Assert (IsDefImp (scope)) ;
-            (* if this fails then we need to skip to the outer scope.
-            REPEAT
-             OuterModule := GetScope(OuterModule)
-            UNTIL GetScope(OuterModule)=NulSym ;  *)
-            IF GetDeclaredDefinition (sym) = UnknownTokenNo
-            THEN
-               doError (eb, GetDeclaredMod (sym))
-            ELSE
-               doError (eb, GetDeclaredDef (sym))
-            END
+            doError (eb, GetDeclaredDef (sym))
          END
       END
    END ;
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
index 2b78add..4cb7f8f 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -87,6 +87,8 @@ VAR
    LineDirectives,               (* Should compiler understand preprocessor  *)
                                  (* # linenumber "filename" markers?         *)
    StrictTypeChecking,           (* -fm2-strict-type experimental checker.   *)
+   StrictTypeAssignment,         (* -fm2-strict-assignment.                  *)
+   StrictTypeReason,             (* -fm2-strict-reason.                      *)
    CPreProcessor,                (* Must we run the cpp on the source?       *)
    Xcode,                        (* Should errors follow Xcode format?       *)
    ExtendedOpaque,               (* Do we allow non pointer opaque types?    *)
@@ -756,6 +758,20 @@ PROCEDURE SetStrictTypeChecking (value: BOOLEAN) ;
 
 
 (*
+   SetStrictTypeAssignment - assigns the StrictTypeAssignment flag to value.
+*)
+
+PROCEDURE SetStrictTypeAssignment (value: BOOLEAN) ;
+
+
+(*
+   SetStrictTypeReason - assigns the StrictTypeReason flag to value.
+*)
+
+PROCEDURE SetStrictTypeReason (value: BOOLEAN) ;
+
+
+(*
    setdefextension - set the source file definition module extension to arg.
                      This should include the . and by default it is set to .def.
 *)
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index 39f0b2a..542b87b 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -657,6 +657,26 @@ END SetStrictTypeChecking ;
 
 
 (*
+   SetStrictTypeAssignment - assigns the StrictTypeAssignment flag to value.
+*)
+
+PROCEDURE SetStrictTypeAssignment (value: BOOLEAN) ;
+BEGIN
+   StrictTypeAssignment := value
+END SetStrictTypeAssignment ;
+
+
+(*
+   SetStrictTypeReason - assigns the StrictTypeReason flag to value.
+*)
+
+PROCEDURE SetStrictTypeReason (value: BOOLEAN) ;
+BEGIN
+   StrictTypeReason := value
+END SetStrictTypeReason ;
+
+
+(*
    SetVerboseUnbounded - sets the VerboseUnbounded flag to, value.
 *)
 
@@ -2111,6 +2131,8 @@ BEGIN
    UnusedVariableChecking            := FALSE ;
    UnusedParameterChecking           := FALSE ;
    StrictTypeChecking                := TRUE ;
+   StrictTypeAssignment              := TRUE ;
+   StrictTypeReason                  := TRUE ;
    AutoInit                          := FALSE ;
    SaveTemps                         := FALSE ;
    ScaffoldDynamic                   := TRUE ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index a45d67a..748ce24 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,
@@ -225,6 +226,7 @@ FROM M2Options IMPORT NilChecking,
                       GenerateLineDebug, Exceptions,
                       Profiling, Coding, Optimizing,
                       UninitVariableChecking,
+                      StrictTypeAssignment,
                       ScaffoldDynamic, ScaffoldStatic, cflag,
                       ScaffoldMain, SharedFlag, WholeProgram,
                       GetDumpDir, GetM2DumpFilter,
@@ -257,8 +259,10 @@ FROM M2Range IMPORT InitAssignmentRangeCheck,
                     InitRotateCheck,
                     InitShiftCheck,
                     InitTypesAssignmentCheck,
+                    InitTypesIndrXCheck,
                     InitTypesExpressionCheck,
                     InitTypesParameterCheck,
+                    InitTypesReturnTypeCheck,
                     InitForLoopBeginRangeCheck,
                     InitForLoopToRangeCheck,
                     InitForLoopEndRangeCheck,
@@ -283,7 +287,6 @@ IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
 CONST
    DebugStackOn = TRUE ;
    DebugVarients = FALSE ;
-   BreakAtQuad = 758 ;
    DebugTokPos = FALSE ;
 
 TYPE
@@ -396,6 +399,7 @@ VAR
                                       (* in order.                               *)
    NoOfQuads            : CARDINAL ;  (* Number of used quadruples.              *)
    Head                 : CARDINAL ;  (* Head of the list of quadruples.         *)
+   BreakQuad            : CARDINAL ;  (* Stop when BreakQuad is created.         *)
 
 
 (*
@@ -1486,22 +1490,6 @@ BEGIN
 END AddQuadInformation ;
 
 
-PROCEDURE stop ; BEGIN END stop ;
-
-
-(*
-   CheckBreak - check whether QuadNo = BreakAtQuad and if so call stop.
-*)
-
-PROCEDURE CheckBreak (QuadNo: CARDINAL) ;
-BEGIN
-   IF QuadNo = BreakAtQuad
-   THEN
-      stop
-   END
-END CheckBreak ;
-
-
 (*
    PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
               sets a boolean to determinine whether overflow should be checked.
@@ -3887,6 +3875,10 @@ BEGIN
       THEN
          MetaErrorT1 (combinedtok, 'combined {%1Oad}', Des)
       END ;
+      IF StrictTypeAssignment
+      THEN
+         BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp))
+      END ;
       IF (GetSType (Des) # NulSym) AND (NOT IsSet (GetDType (Des)))
       THEN
          (* Tell code generator to test runtime values of assignment so ensure we
@@ -4654,6 +4646,8 @@ BEGIN
                    BySym) ;
       MetaErrorDecl (BySym, TRUE)
    ELSE
+      e1 := DereferenceLValue (e1tok, e1) ;
+      e2 := DereferenceLValue (e2tok, e2) ;
       GenQuadOTypetok (bytok, LastForIteratorOp, LastIterator,
                        Make2Tuple (e1, e2), BySym, FALSE, FALSE,
                        bytok, MakeVirtual2Tok (e1tok, e2tok), bytok)
@@ -5627,7 +5621,7 @@ VAR
    proctok,
    paramtok    : CARDINAL ;
    n1, n2      : Name ;
-   ParamCheckId,   
+   ParamCheckId,
    Dim,
    Actual,
    FormalI,
@@ -5676,7 +5670,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) ;
@@ -5768,42 +5763,46 @@ VAR
    CheckedProcedure: CARDINAL ;
    e               : Error ;
 BEGIN
-   n := NoOfParamAny (ProcType) ;
    IF IsVar(call) OR IsTemporary(call) OR IsParameter(call)
    THEN
       CheckedProcedure := GetDType(call)
    ELSE
       CheckedProcedure := call
    END ;
-   IF n # NoOfParamAny (CheckedProcedure)
+   IF ProcType # CheckedProcedure
    THEN
-      e := NewError(GetDeclaredMod(ProcType)) ;
-      n1 := GetSymName(call) ;
-      n2 := GetSymName(ProcType) ;
-      ErrorFormat2(e, 'procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters',
-                   n1, n2) ;
-      e := ChainError(GetDeclaredMod(call), e) ;
-      t := NoOfParamAny (CheckedProcedure) ;
-      IF n<2
+      n := NoOfParamAny (ProcType) ;
+      (* We need to check the formal parameters between the procedure and proc type.  *)
+      IF n # NoOfParamAny (CheckedProcedure)
       THEN
-         ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)',
-                      n1, n, t)
-      ELSE
-         ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameters, declared with (%d)',
-                      n1, n, t)
-      END
-   ELSE
-      i := 1 ;
-      WHILE i<=n DO
-         IF IsVarParamAny (ProcType, i) # IsVarParamAny (CheckedProcedure, i)
+         e := NewError(GetDeclaredMod(ProcType)) ;
+         n1 := GetSymName(call) ;
+         n2 := GetSymName(ProcType) ;
+         ErrorFormat2(e, 'procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters',
+                      n1, n2) ;
+         e := ChainError(GetDeclaredMod(call), e) ;
+         t := NoOfParamAny (CheckedProcedure) ;
+         IF n<2
          THEN
-            MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth (ProcType, i), i) ;
-            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),
-                                              GetParam (ProcType, i), ParamCheckId)) ;
-         INC(i)
+            ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)',
+                         n1, n, t)
+         ELSE
+            ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameters, declared with (%d)',
+                         n1, n, t)
+         END
+      ELSE
+         i := 1 ;
+         WHILE i<=n DO
+            IF IsVarParamAny (ProcType, i) # IsVarParamAny (CheckedProcedure, i)
+            THEN
+               MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth (ProcType, i), i) ;
+               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,
+                                                 GetNthParamAnyClosest (CheckedProcedure, i, GetCurrentModule ()),
+                                                 GetParam (ProcType, i), ParamCheckId)) ;
+            INC(i)
+         END
       END
    END
 END CheckProcTypeAndProcedure ;
@@ -6150,7 +6149,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 +6204,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}',
@@ -6270,21 +6269,24 @@ END ExpectVariable ;
    doIndrX - perform des = *exp with a conversion if necessary.
 *)
 
-PROCEDURE doIndrX (tok: CARDINAL;
-                   des, exp: CARDINAL) ;
+PROCEDURE doIndrX (tok: CARDINAL; des, exp: CARDINAL) ;
 VAR
    t: CARDINAL ;
 BEGIN
-   IF GetDType(des)=GetDType(exp)
+   IF GetDType (des) = GetDType (exp)
    THEN
       GenQuadOtok (tok, IndrXOp, des, GetSType (des), exp, TRUE,
                    tok, tok, tok)
    ELSE
+      IF StrictTypeAssignment
+      THEN
+         BuildRange (InitTypesIndrXCheck (tok, des, exp))
+      END ;
       t := MakeTemporary (tok, RightValue) ;
       PutVar (t, GetSType (exp)) ;
       GenQuadOtok (tok, IndrXOp, t, GetSType (exp), exp, TRUE,
                    tok, tok, tok) ;
-      GenQuadOtok (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE,
+      GenQuadOtok (tok, BecomesOp, des, NulSym, doVal (GetSType (des), t), TRUE,
                    tok, UnknownTokenNo, tok)
    END
 END doIndrX ;
@@ -8474,7 +8476,7 @@ BEGIN
       THEN
          (* we cannot test for IsConst(Param) AND (GetSType(Param)=Char)  as the type might not be assigned yet *)
          MetaError1 ('base procedure {%EkHIGH} expects a variable or string constant as its parameter {%1d:rather than {%1d}} {%1asa}', Param)
-      ELSIF IsUnbounded(Type)
+      ELSIF (Type # NulSym) AND IsUnbounded(Type)
       THEN
          BuildHighFromUnbounded (combinedtok)
       ELSE
@@ -9776,11 +9778,30 @@ END CheckBaseTypeValue ;
 
 
 (*
-   GetTypeMin - returns the minimium value of type.
+   GetTypeMin - returns the minimium value of type and generate an error
+                if this is unavailable.
 *)
 
 PROCEDURE GetTypeMin (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ;
 VAR
+   min: CARDINAL ;
+BEGIN
+   min := GetTypeMinLower (tok, func, type) ;
+   IF min = NulSym
+   THEN
+      MetaErrorT1 (tok,
+                   'unable to obtain the {%AkMIN} value for type {%1ad}', type)
+   END ;
+   RETURN min
+END GetTypeMin ;
+
+
+(*
+   GetTypeMinLower - obtain the maximum value for type.
+*)
+
+PROCEDURE GetTypeMinLower (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ;
+VAR
    min, max: CARDINAL ;
 BEGIN
    IF IsSubrange (type)
@@ -9803,22 +9824,38 @@ BEGIN
       RETURN min
    ELSIF GetSType (type) = NulSym
    THEN
-      MetaErrorT1 (tok,
-                   'unable to obtain the {%AkMIN} value for type {%1ad}', type) ;
-      (* non recoverable error.  *)
-      InternalError ('MetaErrorT1 {%AkMIN} should call abort')
+      RETURN NulSym
    ELSE
       RETURN GetTypeMin (tok, func, GetSType (type))
    END
-END GetTypeMin ;
+END GetTypeMinLower ;
 
 
 (*
-   GetTypeMax - returns the maximum value of type.
+   GetTypeMax - returns the maximum value of type and generate an error
+                if this is unavailable.
 *)
 
 PROCEDURE GetTypeMax (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ;
 VAR
+   max: CARDINAL ;
+BEGIN
+   max := GetTypeMaxLower (tok, func, type) ;
+   IF max = NulSym
+   THEN
+      MetaErrorT1 (tok,
+                   'unable to obtain the {%AkMAX} value for type {%1ad}', type)
+   END ;
+   RETURN max
+END GetTypeMax ;
+
+
+(*
+   GetTypeMaxLower - obtain the maximum value for type.
+*)
+
+PROCEDURE GetTypeMaxLower (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ;
+VAR
    min, max: CARDINAL ;
 BEGIN
    IF IsSubrange (type)
@@ -9841,14 +9878,11 @@ BEGIN
       RETURN max
    ELSIF GetSType (type) = NulSym
    THEN
-      MetaErrorT1 (tok,
-                   'unable to obtain the {%AkMAX} value for type {%1ad}', type) ;
-      (* non recoverable error.  *)
-      InternalError ('MetaErrorT1 {%AkMAX} should call abort')
+      RETURN NulSym
    ELSE
       RETURN GetTypeMax (tok, func, GetSType (type))
    END
-END GetTypeMax ;
+END GetTypeMaxLower ;
 
 
 (*
@@ -11261,12 +11295,41 @@ BEGIN
                    n1, n2)
    ELSE
       (* this checks the types are compatible, not the data contents.  *)
-      BuildRange (InitTypesAssignmentCheck (tokno, currentProc, actualVal))
+      BuildRange (InitTypesReturnTypeCheck (tokno, currentProc, actualVal))
    END
 END CheckReturnType ;
 
 
 (*
+   BuildReturnLower - check the return type and value to ensure type
+                      compatibility and no range overflow will occur.
+*)
+
+PROCEDURE BuildReturnLower (tokcombined, tokexpr: CARDINAL; e1, t1: CARDINAL) ;
+VAR
+   e2, t2: CARDINAL ;
+BEGIN
+   (* This will check that the type returned is compatible with
+      the formal return type of the procedure.  *)
+   CheckReturnType (tokcombined, CurrentProc, e1, t1) ;
+   (* Dereference LeftValue if necessary.  *)
+   IF GetMode (e1) = LeftValue
+   THEN
+      t2 := GetSType (CurrentProc) ;
+      e2 := MakeTemporary (tokexpr, RightValue) ;
+      PutVar(e2, t2) ;
+      CheckPointerThroughNil (tokexpr, e1) ;
+      doIndrX (tokexpr, e2, e1) ;
+      e1 := e2
+   END ;
+   (* Here we check the data contents to ensure no overflow.  *)
+   BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e1)) ;
+   GenQuadOtok (tokcombined, ReturnValueOp, e1, NulSym, CurrentProc, FALSE,
+                tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc))
+END BuildReturnLower ;
+
+
+(*
    BuildReturn - Builds the Return part of the procedure.
                  tokreturn is the location of the RETURN keyword.
                  The Stack is expected to contain:
@@ -11285,7 +11348,6 @@ PROCEDURE BuildReturn (tokreturn: CARDINAL) ;
 VAR
    tokcombined,
    tokexpr    : CARDINAL ;
-   e2, t2,
    e1, t1,
    t, f,
    Des        : CARDINAL ;
@@ -11305,26 +11367,18 @@ BEGIN
    tokcombined := MakeVirtualTok (tokreturn, tokreturn, tokexpr) ;
    IF e1 # NulSym
    THEN
-      (* this will check that the type returned is compatible with
-         the formal return type of the procedure.  *)
-      CheckReturnType (tokcombined, CurrentProc, e1, t1) ;
-      (* dereference LeftValue if necessary *)
-      IF GetMode (e1) = LeftValue
-      THEN
-         t2 := GetSType (CurrentProc) ;
-         e2 := MakeTemporary (tokexpr, RightValue) ;
-         PutVar(e2, t2) ;
-         CheckPointerThroughNil (tokexpr, e1) ;
-         doIndrX (tokexpr, e2, e1) ;
-	 (* here we check the data contents to ensure no overflow.  *)
-         BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e2)) ;
-         GenQuadOtok (tokcombined, ReturnValueOp, e2, NulSym, CurrentProc, FALSE,
-                      tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc))
+      (* Check we are in a procedure scope and that the procedure has a return type.  *)
+      IF CurrentProc = NulSym
+      THEN
+         MetaErrorT0 (tokcombined,
+                      '{%1E} attempting to return a value when not in a procedure scope')
+      ELSIF GetSType (CurrentProc) = NulSym
+      THEN
+         MetaErrorT1 (tokcombined,
+                      'attempting to return a value from procedure {%1Ea} which does not have a return type',
+                     CurrentProc)
       ELSE
-	 (* here we check the data contents to ensure no overflow.  *)
-         BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e1)) ;
-         GenQuadOtok (tokcombined, ReturnValueOp, e1, NulSym, CurrentProc, FALSE,
-                      tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc))
+         BuildReturnLower (tokcombined, tokexpr, e1, t1)
       END
    END ;
    GenQuadO (tokcombined, GotoOp, NulSym, NulSym, PopWord (ReturnStack), FALSE) ;
@@ -11449,13 +11503,12 @@ END BuildDesignatorPointerError ;
 (*
    BuildDesignatorArray - Builds the array referencing.
                           The purpose of this procedure is to work out
-                          whether the DesignatorArray is a static or
-                          dynamic array and to call the appropriate
+                          whether the DesignatorArray is a constant string or
+                          dynamic array/static array and to call the appropriate
                           BuildRoutine.
 
                           The Stack is expected to contain:
 
-
                           Entry                   Exit
                           =====                   ====
 
@@ -11468,6 +11521,41 @@ END BuildDesignatorPointerError ;
 *)
 
 PROCEDURE BuildDesignatorArray ;
+BEGIN
+   IF IsConst (OperandT (2)) AND IsConstString (OperandT (2))
+   THEN
+      MetaErrorT1 (OperandTtok (2),
+                   '{%1Ead} is not an array, but a constant string.  Hint use a string constant created with an array constructor',
+                   OperandT (2)) ;
+      BuildDesignatorError ('bad array access')
+   ELSE
+      BuildDesignatorArrayStaticDynamic
+   END
+END BuildDesignatorArray ;
+
+
+(*
+   BuildDesignatorArrayStaticDynamic - Builds the array referencing.
+                                       The purpose of this procedure is to work out
+                                       whether the DesignatorArray is a static or
+                                       dynamic array and to call the appropriate
+                                       BuildRoutine.
+
+                                       The Stack is expected to contain:
+
+
+                                       Entry                   Exit
+                                       =====                   ====
+
+                                Ptr ->
+                                       +--------------+
+                                       | e            |                        <- Ptr
+                                       |--------------|        +------------+
+                                       | Sym  | Type  |        | S    | T   |
+                                       |--------------|        |------------|
+*)
+
+PROCEDURE BuildDesignatorArrayStaticDynamic ;
 VAR
    combinedTok,
    arrayTok,
@@ -11480,10 +11568,7 @@ BEGIN
    IF IsConst (OperandT (2))
    THEN
       type := GetDType (OperandT (2)) ;
-      IF type = NulSym
-      THEN
-         InternalError ('constant type should have been resolved')
-      ELSIF IsArray (type)
+      IF (type # NulSym) AND IsArray (type)
       THEN
          PopTtok (e, exprTok) ;
          PopTFDtok (Sym, Type, dim, arrayTok) ;
@@ -11501,7 +11586,7 @@ BEGIN
    IF (NOT IsVar (OperandT (2))) AND (NOT IsTemporary (OperandT (2)))
    THEN
       MetaErrorT1 (OperandTtok (2),
-                   'can only access arrays using variables or formal parameters not {%1Ead}',
+                   'can only access arrays using constants, variables or formal parameters not {%1Ead}',
                    OperandT (2)) ;
       BuildDesignatorError ('bad array access')
    END ;
@@ -11528,7 +11613,7 @@ BEGIN
                    Sym) ;
       BuildDesignatorError ('bad array access')
    END
-END BuildDesignatorArray ;
+END BuildDesignatorArrayStaticDynamic ;
 
 
 (*
@@ -15996,12 +16081,55 @@ END StressStack ;
 
 
 (*
+   gdbhook - a debugger convenience hook.
+*)
+
+PROCEDURE gdbhook ;
+END gdbhook ;
+
+
+(*
+   BreakWhenQuadCreated - to be called interactively by gdb.
+*)
+
+PROCEDURE BreakWhenQuadCreated (quad: CARDINAL) ;
+BEGIN
+   BreakQuad := quad
+END BreakWhenQuadCreated ;
+
+
+(*
+   CheckBreak - if quad = BreakQuad then call gdbhook.
+*)
+
+PROCEDURE CheckBreak (quad: CARDINAL) ;
+BEGIN
+   IF quad = BreakQuad
+   THEN
+      gdbhook
+   END
+END CheckBreak ;
+
+
+(*
    Init - initialize the M2Quads module, all the stacks, all the lists
           and the quads list.
 *)
 
 PROCEDURE Init ;
 BEGIN
+   BreakWhenQuadCreated (0) ;  (* Disable the intereactive quad watch.  *)
+   (* To examine the quad table when a quad is created run cc1gm2 from gdb
+      and set a break point on gdbhook.
+      (gdb) break gdbhook
+      (gdb) run
+      Now below interactively call BreakWhenQuadCreated with the quad
+      under investigation.  *)
+   gdbhook ;
+   (* Now is the time to interactively call gdb, for example:
+      (gdb) print BreakWhenQuadCreated (1234)
+      (gdb) cont
+      and you will arrive at gdbhook when this quad is created.  *)
    LogicalOrTok := MakeKey('_LOR') ;
    LogicalAndTok := MakeKey('_LAND') ;
    LogicalXorTok := MakeKey('_LXOR') ;
diff --git a/gcc/m2/gm2-compiler/M2Range.def b/gcc/m2/gm2-compiler/M2Range.def
index 42aa142..e825d94 100644
--- a/gcc/m2/gm2-compiler/M2Range.def
+++ b/gcc/m2/gm2-compiler/M2Range.def
@@ -291,6 +291,24 @@ PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL;
 
 
 (*
+   InitTypesIndrXCheck - checks to see that the types of d and e
+                         are assignment compatible.  The type checking
+                         will dereference *e during the type check.
+                         d = *e.
+*)
+
+PROCEDURE InitTypesIndrXCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitTypesReturnTypeCheck - checks to see that the type of val can
+                                   be returned from func.
+*)
+
+PROCEDURE InitTypesReturnTypeCheck (tokno: CARDINAL; func, val: CARDINAL) : CARDINAL ;
+
+
+(*
    InitCaseBounds - creates a case bound range check.
 *)
 
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index 347012b..dcac2ba 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -58,7 +58,7 @@ FROM M2Debug IMPORT Assert ;
 FROM Indexing IMPORT Index, InitIndex, InBounds, PutIndice, GetIndice ;
 FROM Storage IMPORT ALLOCATE ;
 FROM M2ALU IMPORT PushIntegerTree, PushInt, ConvertToInt, Equ, Gre, Less, GreEqu ;
-FROM M2Options IMPORT VariantValueChecking, CaseEnumChecking, GetPIM ;
+FROM M2Options IMPORT VariantValueChecking, CaseEnumChecking, GetPIM, StrictTypeAssignment ;
 
 FROM M2Error IMPORT Error, InternalError, ErrorFormat0, ErrorFormat1, ErrorFormat2, FlushErrors,
                     GetAnnounceScope ;
@@ -91,7 +91,6 @@ FROM M2Check IMPORT ParameterTypeCompatible, ExpressionTypeCompatible, Assignmen
 
 FROM M2Base IMPORT Nil, IsRealType, GetBaseTypeMinMax,
                    Cardinal, Integer, ZType, IsComplexType,
-                   IsAssignmentCompatible,
                    IsExpressionCompatible,
                    IsParameterCompatible,
                    ExceptionAssign,
@@ -115,7 +114,9 @@ FROM M2CaseList IMPORT CaseBoundsResolved, OverlappingCaseBounds,
 TYPE
    TypeOfRange = (assignment, returnassignment, subrangeassignment,
                   inc, dec, incl, excl, shift, rotate,
-                  typeexpr, typeassign, typeparam, paramassign,
+                  typeindrx, typeexpr, typeassign, typeparam,
+                  typereturn,
+                  paramassign,
                   staticarraysubscript,
                   dynamicarraysubscript,
                   forloopbegin, forloopto, forloopend,
@@ -154,6 +155,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 ;
 
 
 (*
@@ -261,9 +290,10 @@ BEGIN
    excl                 : RETURN( ExceptionExcl ) |
    shift                : RETURN( ExceptionShift ) |
    rotate               : RETURN( ExceptionRotate ) |
-   typeassign           : InternalError ('not expecting this case value') |
-   typeparam            : InternalError ('not expecting this case value') |
-   typeexpr             : InternalError ('not expecting this case value') |
+   typeassign,
+   typeparam,
+   typeexpr,
+   typeindrx            : InternalError ('not expecting this case value') |
    paramassign          : RETURN( ExceptionParameterBounds ) |
    staticarraysubscript : RETURN( ExceptionStaticArray ) |
    dynamicarraysubscript: RETURN( ExceptionDynamicArray ) |
@@ -302,6 +332,7 @@ BEGIN
    THEN
       InternalError ('out of memory error')
    ELSE
+      CheckBreak (r) ;
       WITH p^ DO
          type           := none ;
          des            := NulSym ;
@@ -793,7 +824,7 @@ END InitRotateCheck ;
 
 
 (*
-   InitTypesAssignmentCheck - checks to see that the types of, d, and, e,
+   InitTypesAssignmentCheck - checks to see that the types of d and e
                               are assignment compatible.
 *)
 
@@ -808,6 +839,38 @@ END InitTypesAssignmentCheck ;
 
 
 (*
+   InitTypesIndrXCheck - checks to see that the types of d and e
+                         are assignment compatible.  The type checking
+                         will dereference *e during the type check.
+                         d = *e.
+*)
+
+PROCEDURE InitTypesIndrXCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeindrx, d, e) # NIL) ;
+   RETURN r
+END InitTypesIndrXCheck ;
+
+
+(*
+   InitTypesReturnTypeCheck - checks to see that the types of des and func
+                              are assignment compatible.
+*)
+
+PROCEDURE InitTypesReturnTypeCheck (tokno: CARDINAL; func, val: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typereturn, func, val) # NIL) ;
+   RETURN r
+END InitTypesReturnTypeCheck ;
+
+
+(*
    InitTypesParameterCheck - checks to see that the types of, d,
                              and, e, are parameter compatible.
 *)
@@ -1190,9 +1253,11 @@ BEGIN
       excl                 : RETURN( ExceptionExcl#NulSym ) |
       shift                : RETURN( ExceptionShift#NulSym ) |
       rotate               : RETURN( ExceptionRotate#NulSym ) |
-      typeassign           : RETURN( FALSE ) |
-      typeparam            : RETURN( FALSE ) |
-      typeexpr             : RETURN( FALSE ) |
+      typereturn,
+      typeassign,
+      typeparam,
+      typeexpr,
+      typeindrx            : RETURN( FALSE ) |
       paramassign          : RETURN( ExceptionParameterBounds#NulSym ) |
       staticarraysubscript : RETURN( ExceptionStaticArray#NulSym ) |
       dynamicarraysubscript: RETURN( ExceptionDynamicArray#NulSym ) |
@@ -1217,7 +1282,9 @@ END HandlerExists ;
 
 
 (*
-   FoldAssignment -
+   FoldAssignment - attempts to fold the range violation checks.
+                    It does not issue errors on type violations as that
+                    is performed by FoldTypeAssign.
 *)
 
 PROCEDURE FoldAssignment (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
@@ -1230,7 +1297,7 @@ BEGIN
       TryDeclareConstant (exprtok, expr) ;
       IF desLowestType # NulSym
       THEN
-         IF AssignmentTypeCompatible (tokenno, "", des, expr)
+         IF AssignmentTypeCompatible (tokenno, "", des, expr, FALSE)
          THEN
             IF GccKnowsAbout (expr) AND IsConst (expr) AND
                GetMinMax (tokenno, desLowestType, min, max)
@@ -1246,6 +1313,8 @@ BEGIN
                END
             END
          ELSE
+            (* We do not issue an error if these types are incompatible here
+               as this is done by FoldTypeAssign.  *)
             SubQuad (q)
          END
       END
@@ -1257,6 +1326,7 @@ END FoldAssignment ;
    CheckCancelled - check to see if the range has been cancelled and if so remove quad.
 *)
 
+(*
 PROCEDURE CheckCancelled (range: CARDINAL; quad: CARDINAL) ;
 BEGIN
    IF IsCancelled (range)
@@ -1264,6 +1334,7 @@ BEGIN
       SubQuad (quad)
    END
 END CheckCancelled ;
+*)
 
 
 (*
@@ -1726,21 +1797,94 @@ END FoldRotate ;
 
 
 (*
+   FoldTypeReturnFunc - checks to see that val can be returned from func.
+*)
+
+PROCEDURE FoldTypeReturnFunc (q: CARDINAL; tokenNo: CARDINAL; func, val: CARDINAL; r: CARDINAL) ;
+VAR
+   valType,
+   returnType: CARDINAL ;
+BEGIN
+   returnType := GetType (func) ;
+   IF returnType = NulSym
+   THEN
+      IF NOT reportedError (r)
+      THEN
+         MetaErrorsT2 (tokenNo,
+                       'procedure {%1Da} is not a procedure function',
+                       '{%2ad} cannot be returned from {%1Da}',
+                       func, val) ;
+         SubQuad(q)
+      END
+   ELSE
+      valType := val ;
+      IF IsVar (val) AND (GetMode (val) = LeftValue)
+      THEN
+         valType := GetType (val)
+      END ;
+      IF AssignmentTypeCompatible (tokenNo, "", returnType, valType, FALSE)
+      THEN
+         SubQuad (q)
+      ELSE
+         IF NOT reportedError (r)
+         THEN
+            MetaErrorsT2 (tokenNo,
+                          'the return type {%1Etad} used in procedure {%1Da}',
+                          'is incompatible with the returned expression {%1ad}}',
+                          func, val) ;
+            setReported (r) ;
+            FlushErrors
+         END
+      END
+   END
+END FoldTypeReturnFunc ;
+
+
+(*
    FoldTypeAssign -
 *)
 
 PROCEDURE FoldTypeAssign (q: CARDINAL; tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
+BEGIN
+   IF NOT reportedError (r)
+   THEN
+      IF AssignmentTypeCompatible (tokenNo,
+                                   'assignment designator {%1Ea} {%1ta:of type {%1ta}}' +
+                                   ' cannot be assigned with' +
+                                   ' {%2ad: a {%2td} {%2ad}}{!%2ad: {%2ad} of type {%2tad}}',
+                                   des, expr, TRUE)
+      THEN
+         SubQuad (q)
+      ELSE
+         setReported (r) ;
+         FlushErrors
+      END
+   END
+END FoldTypeAssign ;
+
+
+(*
+   FoldTypeIndrX - check to see that des = *expr is type compatible.
+*)
+
+PROCEDURE FoldTypeIndrX (q: CARDINAL; tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
 VAR
+   desType,
    exprType: CARDINAL ;
 BEGIN
-   IF IsProcedure(expr)
+   (* Need to skip over a variable or temporary in des and expr so
+      long as expr is not a procedure.  In the case of des = *expr,
+      both expr and des will be variables due to the property of
+      indirection.  *)
+   desType := GetType (des) ;
+   IF IsProcedure (expr)
    THEN
+      (* Must not GetType for a procedure as it gives the return type.  *)
       exprType := expr
    ELSE
-      exprType := GetType(expr)
+      exprType := GetType (expr)
    END ;
-
-   IF IsAssignmentCompatible (GetType(des), exprType)
+   IF AssignmentTypeCompatible (tokenNo, "", GetType (des), GetType (expr), FALSE)
    THEN
       SubQuad(q)
    ELSE
@@ -1754,14 +1898,16 @@ BEGIN
                           des, expr) ;
          ELSE
             MetaErrorT3 (tokenNo,
-                         'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%3ad:of type {%3ad}} are incompatible',
+                         'assignment designator {%1Ea} {%1ta:of type {%1ta}}' +
+                         ' {%1d:is a {%1d}} and expression {%2a} {%3ad:of type' +
+                         ' {%3ad}} are incompatible',
                          des, expr, exprType)
          END ;
          setReported (r) ;
          FlushErrors
       END
    END
-END FoldTypeAssign ;
+END FoldTypeIndrX ;
 
 
 (*
@@ -1828,35 +1974,90 @@ END FoldTypeExpr ;
 *)
 
 PROCEDURE CodeTypeAssign (tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
+BEGIN
+   IF NOT AssignmentTypeCompatible (tokenNo, "", des, expr, FALSE)
+   THEN
+      IF NOT reportedError (r)
+      THEN
+         MetaErrorT2 (tokenNo,
+                      'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible',
+                      des, expr)
+      END ;
+      setReported (r)
+   END
+END CodeTypeAssign ;
+
+
+(*
+   CodeTypeReturnFunc -
+*)
+
+PROCEDURE CodeTypeReturnFunc (tokenNo: CARDINAL; func, val: CARDINAL; r: CARDINAL) ;
 VAR
-   exprType: CARDINAL ;
+   valType,
+   returnType: CARDINAL ;
 BEGIN
-   IF IsProcedure(expr)
+   returnType := GetType (func) ;
+   IF returnType = NulSym
    THEN
-      exprType := expr
+      IF NOT reportedError (r)
+      THEN
+         MetaErrorsT2 (tokenNo,
+                       'procedure {%1Da} is not a procedure function',
+                       '{%2ad} cannot be returned from {%1Da}',
+                       func, val) ;
+      END
    ELSE
-      exprType := GetType(expr)
-   END ;
-   IF NOT IsAssignmentCompatible(GetType(des), exprType)
+      valType := val ;
+      IF IsVar (val) AND (GetMode (val) = LeftValue)
+      THEN
+         valType := GetType (val)
+      END ;
+      IF NOT AssignmentTypeCompatible (tokenNo, "", returnType, valType, FALSE)
+      THEN
+         IF NOT reportedError (r)
+         THEN
+            MetaErrorsT2 (tokenNo,
+                          'the return type {%1Etad} used in procedure function {%1Da}',
+                          'is incompatible with the returned expression {%2EUa} {%2tad:of type {%2tad}}',
+                          func, val)
+         END
+      END
+   END
+END CodeTypeReturnFunc ;
+
+
+(*
+   CodeTypeIndrX - checks that des = *expr is type compatible and generates an error if they
+                   are not compatible.  It skips over the LValue type so that to allow
+                   the error messages to pick up the source variable name rather than
+                   a temporary name or vague name 'expression'.
+*)
+
+PROCEDURE CodeTypeIndrX (tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
+BEGIN
+   IF NOT AssignmentTypeCompatible (tokenNo, "", GetType (des), GetType (expr), FALSE)
    THEN
       IF NOT reportedError (r)
       THEN
-         IF IsProcedure(des)
+         IF IsProcedure (des)
          THEN
-            MetaErrorsT2(tokenNo,
-                         'the return type {%1Etad} declared in procedure {%1Da}',
-                         'is incompatible with the returned expression {%2EUa} {%2tad:of type {%2tad}}',
-                         des, expr) ;
+            MetaErrorsT2 (tokenNo,
+                          'the return type {%1Etad} declared in procedure {%1Da}',
+                          'is incompatible with the returned expression {%2EUa} {%2tad:of type {%2tad}}',
+                          des, expr) ;
          ELSE
-            MetaErrorT2(tokenNo,
-                        'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible',
-                        des, expr)
+            MetaErrorT2 (tokenNo,
+                         'assignment designator {%1Ea} {%1ta:of type {%1ta}}' +
+                         ' {%1d:is a {%1d}} and expression {%2a}' +
+                         ' {%2tad:of type {%2tad}} are incompatible',
+                         des, expr)
          END ;
          setReported (r)
       END
       (* FlushErrors *)
    END
-END CodeTypeAssign ;
+END CodeTypeIndrX ;
 
 
 (*
@@ -1910,9 +2111,11 @@ BEGIN
       THEN
          CASE type OF
 
-         typeassign:  FoldTypeAssign(q, tokenNo, des, expr, r) |
-         typeparam:   FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo, r) |
-         typeexpr:    FoldTypeExpr(q, tokenNo, des, expr, strict, isin, r)
+         typeassign:  FoldTypeAssign (q, tokenNo, des, expr, r) |
+         typeparam :  FoldTypeParam (q, tokenNo, des, expr, procedure, paramNo, r) |
+         typeexpr  :  FoldTypeExpr (q, tokenNo, des, expr, strict, isin, r) |
+         typeindrx :  FoldTypeIndrX (q, tokenNo, des, expr, r) |
+         typereturn:  FoldTypeReturnFunc (q, tokenNo, des, expr, r)
 
          ELSE
             InternalError ('not expecting to reach this point')
@@ -1943,9 +2146,11 @@ BEGIN
       THEN
          CASE type OF
 
-         typeassign:  CodeTypeAssign(tokenNo, des, expr, r) |
-         typeparam:   CodeTypeParam(tokenNo, des, expr, procedure, paramNo) |
-         typeexpr:    CodeTypeExpr(tokenNo, des, expr, strict, isin, r)
+         typeassign:  CodeTypeAssign (tokenNo, des, expr, r) |
+         typeparam :  CodeTypeParam (tokenNo, des, expr, procedure, paramNo) |
+         typeexpr  :  CodeTypeExpr (tokenNo, des, expr, strict, isin, r) |
+         typeindrx :  CodeTypeIndrX (tokenNo, des, expr, r) |
+         typereturn:  CodeTypeReturnFunc (tokenNo, des, expr, r)
 
          ELSE
             InternalError ('not expecting to reach this point')
@@ -1974,7 +2179,7 @@ BEGIN
    success := TRUE ;
    WITH p^ DO
       combinedtok := MakeVirtual2Tok (destok, exprtok) ;
-      IF NOT AssignmentTypeCompatible (combinedtok, "", des, expr)
+      IF NOT AssignmentTypeCompatible (combinedtok, "", des, expr, TRUE)
       THEN
          MetaErrorT2 (combinedtok,
                       'type incompatibility between {%1Et} and {%2t} detected during the assignment of the designator {%1a} to the first expression {%2a} in the {%kFOR} loop',
@@ -2388,9 +2593,11 @@ BEGIN
       excl                 :  FoldExcl(tokenno, quad, range) |
       shift                :  FoldShift(tokenno, quad, range) |
       rotate               :  FoldRotate(tokenno, quad, range) |
-      typeassign           :  FoldTypeCheck(tokenno, quad, range) |
-      typeparam            :  FoldTypeCheck(tokenno, quad, range) |
-      typeexpr             :  FoldTypeCheck(tokenno, quad, range) |
+      typereturn,
+      typeassign,
+      typeparam,
+      typeexpr,
+      typeindrx            :  FoldTypeCheck (tokenno, quad, range) |
       paramassign          :  FoldParameterAssign(tokenno, quad, range) |
       staticarraysubscript :  FoldStaticArraySubscript(tokenno, quad, range) |
       dynamicarraysubscript:  FoldDynamicArraySubscript(tokenno, quad, range) |
@@ -3526,6 +3733,8 @@ BEGIN
       typeassign           :  s := NIL |
       typeparam            :  s := NIL |
       typeexpr             :  s := NIL |
+      typeindrx            :  s := InitString ('assignment between designator {%1ad} and {%2ad} is incompatible') |
+      typereturn           :  s := InitString ('the value {%2ad} returned from procedure function {%1a} is type incompatible, expecting {%1tad} rather than a {%2tad}') |
       paramassign          :  s := InitString('if this call is executed then the actual parameter {%2Wa} will be out of range of the {%3N} formal parameter {%1a}') |
       staticarraysubscript :  s := InitString('if this access to the static array {%1Wa:{%2a:{%1a}[{%2a}]}} is ever made then the index will be out of bounds in the {%3N} array subscript') |
       dynamicarraysubscript:  s := InitString('if this access to the dynamic array {%1Wa:{%2a:{%1a}[{%2a}]}} is ever made then the index will be out of bounds in the {%3N} array subscript') |
@@ -3574,9 +3783,11 @@ BEGIN
       excl                 :  CodeInclExcl (tokenNo, r, function, message) |
       shift,
       rotate               :  CodeShiftRotate (tokenNo, r, function, message) |
-      typeassign           :  CodeTypeCheck (tokenNo, r) |
-      typeparam            :  CodeTypeCheck (tokenNo, r) |
-      typeexpr             :  CodeTypeCheck (tokenNo, r) |
+      typeassign,
+      typeparam,
+      typeexpr,
+      typeindrx,
+      typereturn           :  CodeTypeCheck (tokenNo, r) |
       staticarraysubscript :  CodeStaticArraySubscript (tokenNo, r, function, message) |
       dynamicarraysubscript:  CodeDynamicArraySubscript (tokenNo, r, function, message) |
       forloopbegin         :  CodeForLoopBegin (tokenNo, r, function, message) |
@@ -3712,6 +3923,8 @@ BEGIN
       rotate               :  WriteString('rotate(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
       typeexpr             :  WriteString('expr compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
       typeassign           :  WriteString('assignment compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      typeindrx            :  WriteString('indrx compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      typereturn           :  WriteString('return compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
       typeparam            :  WriteString('parameter compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
       paramassign          :  WriteString('parameter range (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
       staticarraysubscript :  WriteString('staticarraysubscript(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
@@ -3744,7 +3957,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/M2System.mod b/gcc/m2/gm2-compiler/M2System.mod
index efd5d11..68ed9dc 100644
--- a/gcc/m2/gm2-compiler/M2System.mod
+++ b/gcc/m2/gm2-compiler/M2System.mod
@@ -61,7 +61,7 @@ FROM NameKey IMPORT Name, MakeKey, NulName ;
 FROM M2Batch IMPORT MakeDefinitionSource ;
 FROM M2Base IMPORT Cardinal, ZType ;
 FROM M2Size IMPORT Size, MakeSize ;
-FROM M2ALU IMPORT PushCard, PushIntegerTree, DivTrunc ;
+FROM M2ALU IMPORT PushCard, PushIntegerTree, PushRealTree, DivTrunc ;
 FROM M2Error IMPORT InternalError ;
 FROM Lists IMPORT List, InitList, IsItemInList, PutItemIntoList, GetItemFromList, NoOfItemsInList ;
 FROM SymbolKey IMPORT SymbolTree, InitTree, GetSymKey, PutSymKey ;
@@ -114,21 +114,32 @@ END Init ;
 
 
 (*
-   CreateMinMaxFor - creates the min and max values for, type, given gccType.
+   CreateMinMaxFor - creates the min and max values for type given gccType.
 *)
 
-PROCEDURE CreateMinMaxFor (type: CARDINAL; min, max: ARRAY OF CHAR; gccType: tree) ;
+PROCEDURE CreateMinMaxFor (type: CARDINAL; min, max: ARRAY OF CHAR;
+                           gccType: tree; realtype: BOOLEAN) ;
 VAR
    maxval, minval: CARDINAL ;
 BEGIN
    maxval := MakeConstVar (BuiltinTokenNo, MakeKey(max)) ;
-   PushIntegerTree (GetMaxFrom (BuiltinsLocation (), gccType)) ;
+   IF realtype
+   THEN
+      PushRealTree (GetMaxFrom (BuiltinsLocation (), gccType))
+   ELSE
+      PushIntegerTree (GetMaxFrom (BuiltinsLocation (), gccType))
+   END ;
    PopValue (maxval) ;
    PutVar (maxval, type) ;
    PutSymKey (MaxValues, GetSymName (type), maxval) ;
 
    minval := MakeConstVar (BuiltinTokenNo, MakeKey(min)) ;
-   PushIntegerTree (GetMinFrom (BuiltinsLocation (), gccType)) ;
+   IF realtype
+   THEN
+      PushRealTree (GetMinFrom (BuiltinsLocation (), gccType))
+   ELSE
+      PushIntegerTree (GetMinFrom (BuiltinsLocation (), gccType))
+   END ;
    PopValue (minval) ;
    PutVar (minval, type) ;
    PutSymKey (MinValues, GetSymName (type), minval)
@@ -136,31 +147,32 @@ END CreateMinMaxFor ;
 
 
 (*
-   MapType -
+   MapType - create a mapping of the M2 frontend type to gcctype.
 *)
 
 PROCEDURE MapType (type: CARDINAL;
                    name, min, max: ARRAY OF CHAR;
-                   needsExporting: BOOLEAN; t: tree) ;
+                   needsExporting: BOOLEAN;
+                   gcctype: tree; realtype: BOOLEAN) ;
 VAR
    n: Name ;
 BEGIN
-   PushIntegerTree(BuildSize(BuiltinsLocation(), t, FALSE)) ;
-   PopSize(type) ;
-   IF IsItemInList(SystemTypes, type)
+   PushIntegerTree (BuildSize (BuiltinsLocation (), gcctype, FALSE)) ;
+   PopSize (type) ;
+   IF IsItemInList (SystemTypes, type)
    THEN
       InternalError ('not expecting system type to already be declared')
    END ;
-   PutItemIntoList(SystemTypes, type) ;
+   PutItemIntoList (SystemTypes, type) ;
 
-   (* create min, max constants if type is ordinal *)
-   IF (NOT StrEqual(min, '')) AND (NOT StrEqual(max, ''))
+   (* Create min, max constants if type is ordinal or a floating point type.  *)
+   IF (NOT StrEqual (min, '')) AND (NOT StrEqual (max, ''))
    THEN
-      CreateMinMaxFor(type, min, max, t)
+      CreateMinMaxFor (type, min, max, gcctype, realtype)
    END ;
    IF needsExporting AND DumpSystemExports
    THEN
-      n := GetSymName(type) ;
+      n := GetSymName (type) ;
       printf1('SYSTEM module creates type: %a\n', n)
    END
 END MapType ;
@@ -171,7 +183,8 @@ END MapType ;
 *)
 
 PROCEDURE CreateType (name, min, max: ARRAY OF CHAR;
-                      needsExporting: BOOLEAN; gccType: tree) : CARDINAL ;
+                      needsExporting: BOOLEAN; gccType: tree;
+                      realtype: BOOLEAN) : CARDINAL ;
 VAR
    type: CARDINAL ;
 BEGIN
@@ -183,7 +196,7 @@ BEGIN
       (* Create base type.  *)
       type := MakeType (BuiltinTokenNo, MakeKey (name)) ;
       PutType (type, NulSym) ;  (* a Base Type *)
-      MapType (type, name, min, max, needsExporting, gccType) ;
+      MapType (type, name, min, max, needsExporting, gccType, realtype) ;
       RETURN type
    END
 END CreateType ;
@@ -195,9 +208,11 @@ END CreateType ;
 *)
 
 PROCEDURE AttemptToCreateType (name, min, max: ARRAY OF CHAR;
-                               needsExporting: BOOLEAN; gccType: tree) ;
+                               needsExporting: BOOLEAN; gccType: tree;
+                               realtype: BOOLEAN) ;
 BEGIN
-   Assert (IsLegal (CreateType (name, min, max, needsExporting, gccType)))
+   Assert (IsLegal (CreateType (name, min, max, needsExporting,
+                                gccType, realtype)))
 END AttemptToCreateType ;
 
 
@@ -226,7 +241,7 @@ BEGIN
       subrange := MakeSubrange (BuiltinTokenNo, NulName) ;
       PutSubrange (subrange, low, high, Cardinal) ;
       PutSet (type, subrange, FALSE) ;
-      MapType (type, name, '', '', needsExporting, gccType) ;
+      MapType (type, name, '', '', needsExporting, gccType, FALSE) ;
       RETURN type
    END
 END CreateSetType ;
@@ -251,33 +266,33 @@ END AttemptToCreateSetType ;
 
 PROCEDURE MakeFixedSizedTypes ;
 BEGIN
-   AttemptToCreateType ('INTEGER8', 'MinInteger8', 'MaxInteger8', TRUE, GetM2Integer8 ()) ;
-   AttemptToCreateType ('INTEGER16', 'MinInteger16', 'MaxInteger16', TRUE, GetM2Integer16 ()) ;
-   AttemptToCreateType ('INTEGER32', 'MinInteger32', 'MaxInteger32', TRUE, GetM2Integer32 ()) ;
-   AttemptToCreateType ('INTEGER64', 'MinInteger64', 'MaxInteger64', TRUE, GetM2Integer64 ()) ;
+   AttemptToCreateType ('INTEGER8', 'MinInteger8', 'MaxInteger8', TRUE, GetM2Integer8 (), FALSE) ;
+   AttemptToCreateType ('INTEGER16', 'MinInteger16', 'MaxInteger16', TRUE, GetM2Integer16 (), FALSE) ;
+   AttemptToCreateType ('INTEGER32', 'MinInteger32', 'MaxInteger32', TRUE, GetM2Integer32 (), FALSE) ;
+   AttemptToCreateType ('INTEGER64', 'MinInteger64', 'MaxInteger64', TRUE, GetM2Integer64 (), FALSE) ;
 
-   AttemptToCreateType ('CARDINAL8', 'MinCardinal8', 'MaxCardinal8', TRUE, GetM2Cardinal8 ()) ;
-   AttemptToCreateType ('CARDINAL16', 'MinCardinal16', 'MaxCardinal16', TRUE, GetM2Cardinal16 ()) ;
-   AttemptToCreateType ('CARDINAL32', 'MinCardinal32', 'MaxCardinal32', TRUE, GetM2Cardinal32 ()) ;
-   AttemptToCreateType ('CARDINAL64', 'MinCardinal64', 'MaxCardinal64', TRUE, GetM2Cardinal64 ()) ;
+   AttemptToCreateType ('CARDINAL8', 'MinCardinal8', 'MaxCardinal8', TRUE, GetM2Cardinal8 (), FALSE) ;
+   AttemptToCreateType ('CARDINAL16', 'MinCardinal16', 'MaxCardinal16', TRUE, GetM2Cardinal16 (), FALSE) ;
+   AttemptToCreateType ('CARDINAL32', 'MinCardinal32', 'MaxCardinal32', TRUE, GetM2Cardinal32 (), FALSE) ;
+   AttemptToCreateType ('CARDINAL64', 'MinCardinal64', 'MaxCardinal64', TRUE, GetM2Cardinal64 (), FALSE) ;
 
-   AttemptToCreateType ('WORD16', '', '', TRUE, GetM2Word16 ()) ;
-   AttemptToCreateType ('WORD32', '', '', TRUE, GetM2Word32 ()) ;
-   AttemptToCreateType ('WORD64', '', '', TRUE, GetM2Word64 ()) ;
+   AttemptToCreateType ('WORD16', '', '', TRUE, GetM2Word16 (), FALSE) ;
+   AttemptToCreateType ('WORD32', '', '', TRUE, GetM2Word32 (), FALSE) ;
+   AttemptToCreateType ('WORD64', '', '', TRUE, GetM2Word64 (), FALSE) ;
 
    AttemptToCreateSetType ('BITSET8' , '7' , TRUE, GetM2Bitset8 ()) ;
    AttemptToCreateSetType ('BITSET16', '15', TRUE, GetM2Bitset16 ()) ;
    AttemptToCreateSetType ('BITSET32', '31', TRUE, GetM2Bitset32 ()) ;
 
-   AttemptToCreateType ('REAL32', '', '', TRUE, GetM2Real32 ()) ;
-   AttemptToCreateType ('REAL64', '', '', TRUE, GetM2Real64 ()) ;
-   AttemptToCreateType ('REAL96', '', '', TRUE, GetM2Real96 ()) ;
-   AttemptToCreateType ('REAL128', '', '', TRUE, GetM2Real128 ()) ;
+   AttemptToCreateType ('REAL32', 'MinReal32', 'MaxReal32', TRUE, GetM2Real32 (), TRUE) ;
+   AttemptToCreateType ('REAL64', 'MinReal64', 'MaxReal64', TRUE, GetM2Real64 (), TRUE) ;
+   AttemptToCreateType ('REAL96', 'MinReal96', 'MaxReal96', TRUE, GetM2Real96 (), TRUE) ;
+   AttemptToCreateType ('REAL128', 'MinReal128', 'MaxReal128', TRUE, GetM2Real128 (), TRUE) ;
 
-   AttemptToCreateType ('COMPLEX32', '', '', TRUE, GetM2Complex32 ()) ;
-   AttemptToCreateType ('COMPLEX64', '', '', TRUE, GetM2Complex64 ()) ;
-   AttemptToCreateType ('COMPLEX96', '', '', TRUE, GetM2Complex96 ()) ;
-   AttemptToCreateType ('COMPLEX128', '', '', TRUE, GetM2Complex128 ())
+   AttemptToCreateType ('COMPLEX32', '', '', TRUE, GetM2Complex32 (), TRUE) ;
+   AttemptToCreateType ('COMPLEX64', '', '', TRUE, GetM2Complex64 (), TRUE) ;
+   AttemptToCreateType ('COMPLEX96', '', '', TRUE, GetM2Complex96 (), TRUE) ;
+   AttemptToCreateType ('COMPLEX128', '', '', TRUE, GetM2Complex128 (), TRUE)
 END MakeFixedSizedTypes ;
 
 
@@ -287,16 +302,16 @@ END MakeFixedSizedTypes ;
 
 PROCEDURE InitPIMTypes ;
 BEGIN
-   Loc := CreateType ('LOC', '', '', TRUE, GetISOLocType()) ;
+   Loc := CreateType ('LOC', '', '', TRUE, GetISOLocType(), FALSE) ;
    InitSystemTypes(BuiltinsLocation(), Loc) ;
-   Word := CreateType ('WORD', '', '', TRUE, GetWordType()) ;
-   Byte := CreateType ('BYTE', '', '', TRUE, GetByteType()) ;
+   Word := CreateType ('WORD', '', '', TRUE, GetWordType(), FALSE) ;
+   Byte := CreateType ('BYTE', '', '', TRUE, GetByteType(), FALSE) ;
 
    (* ADDRESS = POINTER TO BYTE *)
 
    Address := MakePointer (BuiltinTokenNo, MakeKey('ADDRESS')) ;
    PutPointer (Address, Byte) ;                (* Base Type       *)
-   MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType())
+   MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType(), FALSE)
 END InitPIMTypes ;
 
 
@@ -306,17 +321,15 @@ END InitPIMTypes ;
 
 PROCEDURE InitISOTypes ;
 BEGIN
-   Loc := CreateType ('LOC', 'MinLoc', 'MaxLoc', TRUE, GetISOLocType ()) ;
+   Loc := CreateType ('LOC', 'MinLoc', 'MaxLoc', TRUE, GetISOLocType (), FALSE) ;
    InitSystemTypes (BuiltinsLocation (), Loc) ;
 
    Address := MakePointer (BuiltinTokenNo, MakeKey ('ADDRESS')) ;
    PutPointer (Address, Loc) ;                (* Base Type       *)
-   MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType()) ;
-
-   Byte := CreateType ('BYTE', '', '', TRUE, GetISOByteType()) ;
-   Word := CreateType ('WORD', '', '', TRUE, GetISOWordType()) ;
+   MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType(), FALSE) ;
 
-   (* CreateMinMaxFor(Loc, 'MinLoc', 'MaxLoc', GetISOLocType()) *)
+   Byte := CreateType ('BYTE', '', '', TRUE, GetISOByteType(), FALSE) ;
+   Word := CreateType ('WORD', '', '', TRUE, GetISOWordType(), FALSE) ;
 END InitISOTypes ;
 
 
@@ -327,9 +340,9 @@ END InitISOTypes ;
 
 PROCEDURE MakeExtraSystemTypes ;
 BEGIN
-   CSizeT  := CreateType ('CSIZE_T' , '', '', TRUE, GetCSizeTType ()) ;
-   CSSizeT := CreateType ('CSSIZE_T', '', '', TRUE, GetCSSizeTType ()) ;
-   COffT := CreateType ('COFF_T', '', '', TRUE, GetCOffTType ()) ;
+   CSizeT  := CreateType ('CSIZE_T' , '', '', TRUE, GetCSizeTType (), FALSE) ;
+   CSSizeT := CreateType ('CSSIZE_T', '', '', TRUE, GetCSSizeTType (), FALSE) ;
+   COffT := CreateType ('COFF_T', '', '', TRUE, GetCOffTType (), FALSE)
 END MakeExtraSystemTypes ;
 
 
@@ -425,9 +438,9 @@ BEGIN
                           MakeKey('THROW')) ;       (* Procedure       *)
    PutProcedureNoReturn (Throw, DefProcedure, TRUE) ;
 
-   CreateMinMaxFor(Word, 'MinWord', 'MaxWord', GetWordType()) ;
-   CreateMinMaxFor(Address, 'MinAddress', 'MaxAddress', GetPointerType()) ;
-   CreateMinMaxFor(Byte, 'MinByte', 'MaxByte', GetByteType()) ;
+   CreateMinMaxFor(Word, 'MinWord', 'MaxWord', GetWordType(), FALSE) ;
+   CreateMinMaxFor(Address, 'MinAddress', 'MaxAddress', GetPointerType(), FALSE) ;
+   CreateMinMaxFor(Byte, 'MinByte', 'MaxByte', GetByteType(), FALSE) ;
 
    MakeFixedSizedTypes ;
    MakeExtraSystemTypes ;
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index b9a6daa..c28e630 100644
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -46,7 +46,8 @@ see <https://www.gnu.org/licenses/>.  *)
 IMPLEMENTATION MODULE P2Build ;
 
 FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
-                     InsertTokenAndRewind, GetTokenNo, MakeVirtual2Tok ;
+                     InsertTokenAndRewind, GetTokenNo, MakeVirtual2Tok,
+		     MakeVirtualTok ;
 
 FROM M2MetaError IMPORT MetaErrorStringT0, MetaErrorT1 ;
 FROM NameKey IMPORT NulName, Name, makekey, MakeKey ;
@@ -128,13 +129,13 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
                         PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
                         MakeRegInterface,
                         PutRegInterface, GetRegInterface,
-                        GetSymName, GetType, MakeConstLit,
+                        GetSymName, GetType, MakeConstLit, IsProcType,
                         NulSym,
-                        StartScope, EndScope,
+                        StartScope, EndScope, GetCurrentModule,
                         PutIncluded,
                         PutExceptionFinally, PutExceptionBlock, GetCurrentScope,
                         IsVarParam, IsProcedure, IsDefImp, IsModule,
-                        IsRecord, IsAModula2Type,
+                        IsRecord, IsAModula2Type, IsImported,
                         RequestSym ;
 
 IMPORT M2Error ;
@@ -450,6 +451,54 @@ BEGIN
    Expect(realtok, stopset0, stopset1, stopset2)
 END Real ;
 
+
+(*
+   CheckModuleQualident - check to see if the beginning ident of the qualident is an
+                          imported module.
+*)
+
+PROCEDURE CheckModuleQualident (stopset0: SetOfStop0;
+                                stopset1: SetOfStop1;
+				stopset2: SetOfStop2) ;
+VAR
+   name         : Name ;
+   init,
+   nextLevel,
+   tok, tokstart: CARDINAL ;
+BEGIN
+   PopTtok (name, tokstart) ;
+   tok := tokstart ;
+   init := RequestSym (tok, name) ;
+   IF IsImported (GetCurrentModule (), init) AND (IsDefImp (init) OR IsModule (init))
+   THEN
+      WHILE IsDefImp (init) OR IsModule (init) DO
+         Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+         StartScope (init) ;
+         Ident (stopset0, stopset1, stopset2) ;
+	 PopTtok (name, tok) ;
+         nextLevel := RequestSym (tok, name) ;
+         EndScope ;
+	 init := nextLevel
+      END ;
+      IF tok#tokstart
+      THEN
+         tok := MakeVirtualTok (tokstart, tokstart, tok)
+      END ;
+      IF IsProcedure (init) OR IsProcType (init)
+      THEN
+         PushTtok (init, tok)
+      ELSE
+         Annotate ("%1s(%1d)|%1s(%1d)||qualident|type") ;
+         PushTFtok (init, GetType (init), tok) ;
+      END ;
+      PutIncluded (init)
+   ELSE
+      PushTFtok (init, GetType (init), tok) ;
+      Annotate ("%1s(%1d)|%1s(%1d)||qualident|type")
+   END
+END CheckModuleQualident ;
+
+
 % module P2Build end
 END P2Build.
 % rules
@@ -609,28 +658,10 @@ ImplementationOrProgramModule := ImplementationModule | ProgramModule =:
 
 Number := Integer | Real =:
 
-Qualident :=                                                               % VAR name: Name ;
-                                                                                 Type, Sym, tok: CARDINAL ; %
-             Ident
+Qualident := Ident
                                                                            % IF IsAutoPushOn()
                                                                              THEN
-                                                                                PopTtok(name, tok) ;
-                                                                                Sym := RequestSym (tok, name) ;
-                                                                                IF IsDefImp(Sym) OR IsModule(Sym)
-                                                                                THEN
-                                                                                   Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
-                                                                                   StartScope(Sym) ;
-                                                                                   Qualident(stopset0, stopset1, stopset2) ;
-                                                                                   (* should we test for lack of ident? *)
-                                                                                   PopTFtok(Sym, Type, tok) ;
-                                                                                   PushTFtok(Sym, Type, tok) ;
-                                                                                   Annotate("%1s(%1d)|%1s(%1d)||qualident|type") ;
-                                                                                   EndScope ;
-                                                                                   PutIncluded(Sym)
-                                                                                ELSE
-                                                                                   PushTFtok(Sym, GetType(Sym), tok) ;
-                                                                                   Annotate("%1s(%1d)|%1s(%1d)||qualident|type")
-                                                                                END
+     										CheckModuleQualident (stopset0, stopset1, stopset2)
                                                                              ELSE (* just parse qualident *) %
              { "." Ident }                                                 % END %
            =:
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 8f3b499..5c82ec8 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1225,7 +1225,8 @@ VAR
    Sym,
    Type     : CARDINAL ;
    name     : Name ;
-   tokno    : CARDINAL ;
+   nametokno,
+   typetokno: CARDINAL ;
 BEGIN
    (*
       Two cases
@@ -1234,8 +1235,8 @@ BEGIN
       - when type with a name that is different to Name. In which case
         we create a new type.
    *)
-   PopTtok(Type, tokno) ;
-   PopT(name) ;
+   PopTtok (Type, typetokno) ;
+   PopTtok (name, nametokno) ;
    IF Debugging
    THEN
       n1 := GetSymName(GetCurrentModule()) ;
@@ -1264,11 +1265,11 @@ BEGIN
 
       *)
       (* WriteString('Blank name type') ; WriteLn ; *)
-      PushTFtok(Type, name, tokno) ;
+      PushTFtok(Type, name, typetokno) ;
       Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
    ELSIF IsError(Type)
    THEN
-      PushTFtok(Type, name, tokno) ;
+      PushTFtok(Type, name, typetokno) ;
       Annotate("%1s(%1d)|%2n|%3d||error type|error type name|token no")
    ELSIF GetSymName(Type)=name
    THEN
@@ -1276,7 +1277,7 @@ BEGIN
       IF isunknown OR
          (NOT IsDeclaredIn(GetCurrentScope(), Type))
       THEN
-         Sym := MakeType(tokno, name) ;
+         Sym := MakeType (typetokno, name) ;
          IF NOT IsError(Sym)
          THEN
             IF Sym=Type
@@ -1295,19 +1296,23 @@ BEGIN
                CheckForEnumerationInCurrentModule(Type)
             END
          END ;
-         PushTFtok(Sym, name, tokno) ;
+         PushTFtok(Sym, name, typetokno) ;
          Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
       ELSE
-         PushTFtok(Type, name, tokno) ;
+         PushTFtok(Type, name, typetokno) ;
          Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
       END
    ELSE
       (* example   TYPE a = CARDINAL *)
-      Sym := MakeType(tokno, name) ;
-      PutType(Sym, Type) ;
-      CheckForExportedImplementation(Sym) ;   (* May be an exported hidden type *)
-      PushTFtok(Sym, name, tokno) ;
-      Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+      Sym := MakeType (nametokno, name) ;
+      PutType (Sym, Type) ;
+      CheckForExportedImplementation (Sym) ;   (* May be an exported hidden type *)
+      PushTFtok (Sym, name, nametokno) ;
+      Annotate ("%1s(%1d)|%2n|%3d||type|type name|token no") ;
+      IF Debugging
+      THEN
+         MetaErrorT1 (nametokno, 'type pos {%1Wa}', Sym)
+      END
    END
 END BuildType ;
 
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 4f6ffb7..0033d33 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -166,14 +166,14 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
                         MakeRegInterface,
                         PutRegInterface,
                         IsRegInterface, IsGnuAsmVolatile, IsGnuAsm,
-                        GetCurrentModule,
+                        GetCurrentModule, IsInnerModule,
                         GetSymName, GetType, SkipType,
                         NulSym,
                         StartScope, EndScope,
                         PutIncluded,
                         IsVarParam, IsProcedure, IsDefImp, IsModule, IsProcType,
                         IsRecord,
-                        RequestSym, IsExported,
+                        RequestSym, IsExported, IsImported,
                         GetSym, GetLocalSym ;
 
 FROM M2Batch IMPORT IsModuleKnown ;
@@ -468,6 +468,69 @@ BEGIN
    Expect(realtok, stopset0, stopset1, stopset2)
 END Real ;
 
+
+(*
+   PushTFQualident - push the result of the Qualident
+                     to the stack.  It checks to see if init
+		     is a procedure or proc type and if so
+		     it does not push the return type.
+*)
+
+PROCEDURE PushTFQualident (tok, tokstart: CARDINAL;
+                           init: CARDINAL) ;
+BEGIN
+   IF tok#tokstart
+   THEN
+      tok := MakeVirtualTok (tokstart, tokstart, tok)
+   END ;
+   IF IsProcedure (init) OR IsProcType (init) OR IsModule (init) OR IsDefImp (init)
+   THEN
+      PushTtok (init, tok) ;
+      Annotate ("%1s(%1d)||qualident procedure/proctype") ;
+   ELSE
+      Annotate ("%1s(%1d)|%1s(%1d)||qualident|type") ;
+      PushTFtok (init, GetType (init), tok) ;
+   END
+END PushTFQualident ;
+
+
+(*
+   CheckModuleQualident - check to see if the beginning ident of the qualident is an
+                          imported module.
+*)
+
+PROCEDURE CheckModuleQualident (stopset0: SetOfStop0;
+                                stopset1: SetOfStop1;
+				stopset2: SetOfStop2) ;
+VAR
+   name         : Name ;
+   init,
+   nextLevel,
+   tok, tokstart: CARDINAL ;
+BEGIN
+   PopTtok (name, tokstart) ;
+   tok := tokstart ;
+   init := RequestSym (tok, name) ;
+   IF (IsImported (GetCurrentModule (), init) AND IsDefImp (init)) OR
+      IsModule (init)
+   THEN
+      WHILE IsDefImp (init) OR IsModule (init) DO
+         Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+         StartScope (init) ;
+         Ident (stopset0, stopset1, stopset2) ;
+	 PopTtok (name, tok) ;
+         nextLevel := RequestSym (tok, name) ;
+         EndScope ;
+	 CheckCanBeImported (init, nextLevel) ;
+	 init := nextLevel
+      END ;
+      PushTFQualident (tok, tokstart, init) ;
+      PutIncluded (init)
+   ELSE
+      PushTFQualident (tok, tokstart, init)
+   END
+END CheckModuleQualident ;
+
 % module P3Build end
 BEGIN
    BlockState := InitState ()
@@ -643,37 +706,11 @@ Number := Integer | Real =:
 --  IsAutoPushOff then we just consume tokens.
 --
 
-Qualident :=                                                               % VAR name          : Name ;
-                                                                                 init, ip1,
-                                                                                 tokstart, tok : CARDINAL ; %
-             Ident
+Qualident := Ident
                                                                            % IF IsAutoPushOn()
                                                                              THEN
-                                                                                PopTtok(name, tokstart) ;
-										tok := tokstart ;
-                                                                                init := RequestSym (tok, name) ;
-                                                                                WHILE IsDefImp (init) OR IsModule (init) DO
-                                                                                   Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
-                                                                                   StartScope (init) ;
-                                                                                   Ident (stopset0, stopset1, stopset2) ;
-                                                                                   PopTtok (name, tok) ;
-                                                                                   ip1 := RequestSym (tok, name) ;
-                                                                                   PutIncluded(ip1) ;
-                                                                                   EndScope ;
-                                                                                   CheckCanBeImported(init, ip1) ;
-                                                                                   init := ip1
-                                                                                END ;
-										IF tok#tokstart
-										THEN
-										   tok := MakeVirtualTok (tokstart, tokstart, tok)
-										END ;
-                                                                                IF IsProcedure(init) OR IsProcType(init)
-                                                                                THEN
-                                                                                   PushTtok(init, tok)
-                                                                                ELSE
-                                                                                   PushTFtok(init, GetType(init), tok) ;
-                                                                                END
-                                                                             ELSE %
+     										CheckModuleQualident (stopset0, stopset1, stopset2)
+                                                                             ELSE (* just parse qualident *) %
              { "." Ident }                                                 % END %
            =:
 
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index a05a55f..ddbe2f1 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -65,7 +65,7 @@ FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT, Opera
                     PushTFA,
                     PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, PushTFntok,
                     PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto,
-                    DupFrame,
+                    DupFrame, Annotate,
                     BuildTypeForConstructor, BuildConstructor, BuildConstructorEnd,
                     PopConstructor,
                     NextConstructorField, SilentBuildConstructor,
@@ -118,6 +118,7 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
                         PutIncluded,
                         IsVarParam, IsProcedure, IsDefImp, IsModule,
                         IsRecord, IsProcType,
+                        GetCurrentModule, IsInnerModule, IsImported,
                         RequestSym,
                         GetSym, GetLocalSym ;
 
@@ -412,6 +413,68 @@ BEGIN
    Expect(realtok, stopset0, stopset1, stopset2)
 END Real ;
 
+
+(*
+   PushTFQualident - push the result of the Qualident
+                     to the stack.  It checks to see if init
+		     is a procedure or proc type and if so
+		     it does not push the return type.
+*)
+
+PROCEDURE PushTFQualident (tok, tokstart: CARDINAL;
+                           init: CARDINAL) ;
+BEGIN
+   IF tok#tokstart
+   THEN
+      tok := MakeVirtualTok (tokstart, tokstart, tok)
+   END ;
+   IF IsProcedure (init) OR IsProcType (init)
+   THEN
+      PushTtok (init, tok) ;
+      Annotate ("%1s(%1d)||qualident procedure/proctype") ;
+   ELSE
+      Annotate ("%1s(%1d)|%1s(%1d)||qualident|type") ;
+      PushTFtok (init, GetType (init), tok) ;
+   END
+END PushTFQualident ;
+
+
+(*
+   CheckModuleQualident - check to see if the beginning ident of the qualident is an
+                          imported module.
+*)
+
+PROCEDURE CheckModuleQualident (stopset0: SetOfStop0;
+                                stopset1: SetOfStop1;
+				stopset2: SetOfStop2) ;
+VAR
+   name         : Name ;
+   init,
+   nextLevel,
+   tok, tokstart: CARDINAL ;
+BEGIN
+   PopTtok (name, tokstart) ;
+   tok := tokstart ;
+   init := RequestSym (tok, name) ;
+   IF IsImported (GetCurrentModule (), init) AND (IsDefImp (init) OR IsModule (init))
+   THEN
+      WHILE IsDefImp (init) OR IsModule (init) DO
+         Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+         StartScope (init) ;
+         Ident (stopset0, stopset1, stopset2) ;
+	 PopTtok (name, tok) ;
+         nextLevel := RequestSym (tok, name) ;
+         EndScope ;
+	 CheckCanBeImported (init, nextLevel) ;
+	 init := nextLevel
+      END ;
+      PushTFQualident (tok, tokstart, init) ;
+      PutIncluded (init)
+   ELSE
+      PushTFQualident (tok, tokstart, init)
+   END
+END CheckModuleQualident ;
+
 % module PCBuild end
 BEGIN
    BlockState := InitState ()
@@ -569,37 +632,11 @@ ImplementationOrProgramModule :=                                           % Pus
 
 Number := Integer | Real =:
 
-Qualident :=                                                               % VAR name          : Name ;
-                                                                                 init, ip1,
-                                                                                 tokstart, tok : CARDINAL ; %
-             Ident
+Qualident := Ident
                                                                            % IF IsAutoPushOn()
                                                                              THEN
-                                                                                PopTtok(name, tokstart) ;
-										tok := tokstart ;
-                                                                                init := RequestSym (tok, name) ;
-                                                                                WHILE IsDefImp (init) OR IsModule (init) DO
-                                                                                   Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
-                                                                                   StartScope (init) ;
-                                                                                   Ident (stopset0, stopset1, stopset2) ;
-                                                                                   PopTtok (name, tok) ;
-                                                                                   ip1 := RequestSym (tok, name) ;
-                                                                                   PutIncluded(ip1) ;
-                                                                                   EndScope ;
-                                                                                   CheckCanBeImported(init, ip1) ;
-                                                                                   init := ip1
-                                                                                END ;
-										IF tok#tokstart
-										THEN
-										   tok := MakeVirtualTok (tokstart, tokstart, tok)
-										END ;
-                                                                                IF IsProcedure(init) OR IsProcType(init)
-                                                                                THEN
-                                                                                   PushTtok(init, tok)
-                                                                                ELSE
-                                                                                   PushTFtok(init, GetType(init), tok) ;
-                                                                                END
-                                                                             ELSE %
+     										CheckModuleQualident (stopset0, stopset1, stopset2)
+                                                                             ELSE (* just parse qualident *) %
              { "." Ident }                                                 % END %
            =:
 
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
index b124c3e..3bffe86 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -64,7 +64,7 @@ FROM SymbolTable IMPORT NulSym, ModeOfAddr, ProcedureKind,
                         GetFromOuterModule,
                         CheckForEnumerationInCurrentModule,
                         GetMode, PutVariableAtAddress, ModeOfAddr, SkipType,
-                        IsSet, PutConstSet,
+                        IsSet, PutConstSet, IsType,
                         IsConst, IsConstructor, PutConst, PutConstructor,
                         PopValue, PushValue,
                         MakeTemporary, PutVar,
@@ -1408,9 +1408,10 @@ END TypeToMeta ;
 
 
 (*
-   buildConstFunction - we are only concerned about resolving the return type o
+   buildConstFunction - we are only concerned about resolving the return type of
                         a function, so we can ignore all parameters - except
-                        the first one in the case of VAL(type, foo).
+                        the first one in the case of VAL(type, foo)
+                        and the type of bar in MIN (bar) and MAX (bar).
                         buildConstFunction uses a unary exprNode to represent
                         a function.
 *)
@@ -1866,11 +1867,11 @@ BEGIN
             THEN
                IF (func=Min) OR (func=Max)
                THEN
-                  IF IsSet (sym)
+                  IF IsSet (sym) OR (IsType (sym) AND IsSet (SkipType (sym)))
                   THEN
-                     type := SkipType(GetType(sym))
+                     type := GetType (SkipType (sym))
                   ELSE
-                     (* sym is the type required for MAX, MIN and VAL *)
+                     (* sym is the type required for MAX, MIN and VAL.  *)
                      type := sym
                   END
                ELSE
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index 7bd5bcc..8153870 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -130,12 +130,12 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
                         PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
                         MakeRegInterface,
                         PutRegInterface, GetRegInterface,
-                        GetSymName, GetType,
+                        GetSymName, GetType, GetCurrentModule,
                         NulSym,
                         StartScope, EndScope,
                         PutIncluded,
                         IsVarParam, IsProcedure, IsDefImp, IsModule,
-                        IsRecord, IsProcType,
+                        IsRecord, IsProcType, IsInnerModule, IsImported,
                         RequestSym,
                         GetSym, GetLocalSym ;
 
@@ -368,6 +368,68 @@ BEGIN
    Expect(realtok, stopset0, stopset1, stopset2)
 END Real ;
 
+
+(*
+   PushTFQualident - push the result of the Qualident
+                     to the stack.  It checks to see if init
+		     is a procedure or proc type and if so
+		     it does not push the return type.
+*)
+
+PROCEDURE PushTFQualident (tok, tokstart: CARDINAL;
+                           init: CARDINAL) ;
+BEGIN
+   IF tok#tokstart
+   THEN
+      tok := MakeVirtualTok (tokstart, tokstart, tok)
+   END ;
+   IF IsProcedure (init) OR IsProcType (init)
+   THEN
+      PushTtok (init, tok) ;
+      Annotate ("%1s(%1d)||qualident procedure/proctype") ;
+   ELSE
+      Annotate ("%1s(%1d)|%1s(%1d)||qualident|type") ;
+      PushTFtok (init, GetType (init), tok) ;
+   END
+END PushTFQualident ;
+
+
+(*
+   CheckModuleQualident - check to see if the beginning ident of the qualident is an
+                          imported module.
+*)
+
+PROCEDURE CheckModuleQualident (stopset0: SetOfStop0;
+                                stopset1: SetOfStop1;
+				stopset2: SetOfStop2) ;
+VAR
+   name         : Name ;
+   init,
+   nextLevel,
+   tok, tokstart: CARDINAL ;
+BEGIN
+   PopTtok (name, tokstart) ;
+   tok := tokstart ;
+   init := RequestSym (tok, name) ;
+   IF IsImported (GetCurrentModule (), init) AND (IsDefImp (init) OR IsModule (init))
+   THEN
+      WHILE IsDefImp (init) OR IsModule (init) DO
+         Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+         StartScope (init) ;
+         Ident (stopset0, stopset1, stopset2) ;
+	 PopTtok (name, tok) ;
+         nextLevel := RequestSym (tok, name) ;
+         EndScope ;
+	 CheckCanBeImported (init, nextLevel) ;
+	 init := nextLevel
+      END ;
+      PushTFQualident (tok, tokstart, init) ;
+      PutIncluded (init)
+   ELSE
+      PushTFQualident (tok, tokstart, init)
+   END
+END CheckModuleQualident ;
+
 % module PHBuild end
 END PHBuild.
 % rules
@@ -541,26 +603,10 @@ ImplementationOrProgramModule :=                                           % Pus
 Number := Integer | Real =:
 
 
-Qualident :=                                                               % VAR name: Name ;
-                                                                                 Type, Sym, tok: CARDINAL ; %
-             Ident
+Qualident := Ident
                                                                            % IF IsAutoPushOn()
                                                                              THEN
-                                                                                PopTtok(name, tok) ;
-                                                                                Sym := RequestSym (tok, name) ;
-                                                                                IF IsDefImp(Sym) OR IsModule(Sym)
-                                                                                THEN
-                                                                                   Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
-                                                                                   StartScope(Sym) ;
-                                                                                   Qualident(stopset0, stopset1, stopset2) ;
-                                                                                   (* should we test for lack of ident? *)
-                                                                                   PopTFtok(Sym, Type, tok) ;
-                                                                                   PushTFtok(Sym, Type, tok) ;
-                                                                                   EndScope ;
-                                                                                   PutIncluded(Sym)
-                                                                                ELSE
-                                                                                   PushTFtok(Sym, GetType(Sym), tok) ;
-                                                                                END
+     										CheckModuleQualident (stopset0, stopset1, stopset2)
                                                                              ELSE (* just parse qualident *) %
              { "." Ident }                                                 % END %
            =:
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index d9d4c87..2a9865a 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -2025,7 +2025,7 @@ PROCEDURE PutIncludedByDefinition (Sym: CARDINAL) ;
 
 (*
    IsIncludedByDefinition - returns TRUE if definition module symbol, Sym, was included
-                            by ModSym's definition module.
+                            by ModSyms definition module.
 *)
 
 PROCEDURE IsIncludedByDefinition (ModSym, Sym: CARDINAL) : BOOLEAN ;
@@ -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..ff661dc 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.
 *)
@@ -7154,6 +7265,7 @@ VAR
    pSym: PtrToSymbol ;
 BEGIN
    pSym := GetPsym(Sym) ;
+   CheckBreak (Sym) ;
    WITH pSym^ DO
       CASE SymbolType OF