public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Fixes to bootstrap resulting in m2 lto building/passing regression tests [PR93575].
@ 2021-12-30 20:44 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2021-12-30 20:44 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:3431b882d9e07a7da9134cc691cbfbe4eb385c0b

commit 3431b882d9e07a7da9134cc691cbfbe4eb385c0b
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date:   Thu Dec 30 20:43:52 2021 +0000

    Fixes to bootstrap resulting in m2 lto building/passing regression tests [PR93575].
    
            These changes fix indirect procedure calls in the bootstrap tool
            mc which were exposed by lto.  The result is that gm2 can be built
            using profiled lto and all regression tests pass on the amd64
            platform.
    
    gcc/m2/ChangeLog:
    
            * gm2-gcc/m2expr.def: Use FOR "C" keyword and ident.
            * mc-boot/GRTExceptions.c: Rebuilt.
            * mc-boot/GSArgs.c: Rebuilt.
            * mc-boot/Gdecl.c: Rebuilt.
            * mc-boot/Glibc.h: Rebuilt.
            * mc/decl.mod (varparamT): isForC new field.  (paramT) isForC new
            field.  (varargsT) isForC new field.  (putDefForC) Implemented.
            (makeNonVarParameter) assign isForC.  (makeVarParameter) Assign
            isForC. (getParameterVariable) ignore isDefForC.
            (doParamTypeEmit) New procedure.  (doParamC) Call doParamTypeEmit.
            (doVarParamC) call doParamTypeEmit.  (doCompletePartialProcType)
            Emit a C named type which differs from the m2 proctype.
            (doPrototypeC) Ignore isDefForC and extended opaque option.
            (doFuncUnbounded) Disable C string parameters.
            (doProcedureParamC) Handle isForC for a formal parameter.
            (isForC) New procedure function.  (isDefForCNode) New procedure
            function.  (doFuncParamC) Detect var param for a definition
            module for "C" proc type parameter and emit error message.
            Detect param for a definition module for "C" and reference the
            .proc field.  (outputPartialRecordArrayProcType) New procedure.
            (outputPartial) Rewritten.
    
    Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>

Diff:
---
 gcc/m2/gm2-gcc/m2expr.def      |   2 +-
 gcc/m2/mc-boot/GRTExceptions.c |  45 ++++---
 gcc/m2/mc-boot/GSArgs.c        |   2 +-
 gcc/m2/mc-boot/Gdecl.c         | 271 +++++++++++++++++++++++++++++++----------
 gcc/m2/mc-boot/Glibc.h         |   5 +-
 gcc/m2/mc/decl.mod             | 194 ++++++++++++++++++++++-------
 6 files changed, 389 insertions(+), 130 deletions(-)

diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def
index 79c42099a5f..205c613e1e7 100644
--- a/gcc/m2/gm2-gcc/m2expr.def
+++ b/gcc/m2/gm2-gcc/m2expr.def
@@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License
 along with GNU Modula-2; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  *)
 
-DEFINITION MODULE m2expr ;
+DEFINITION MODULE FOR "C" m2expr ;
 
 FROM SYSTEM IMPORT ADDRESS ;
 FROM m2tree IMPORT Tree ;
diff --git a/gcc/m2/mc-boot/GRTExceptions.c b/gcc/m2/mc-boot/GRTExceptions.c
index de125f217a0..1e26c71fd06 100644
--- a/gcc/m2/mc-boot/GRTExceptions.c
+++ b/gcc/m2/mc-boot/GRTExceptions.c
@@ -719,7 +719,7 @@ static void AddHandler (RTExceptions_EHBlock e, Handler h)
 
 static void indexf (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 607, 9, "indexf", "array index out of bounds");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 612, 9, "indexf", "array index out of bounds");
 }
 
 
@@ -729,7 +729,7 @@ static void indexf (void * a)
 
 static void range (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 619, 9, "range", "assignment out of range");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 624, 9, "range", "assignment out of range");
 }
 
 
@@ -739,7 +739,7 @@ static void range (void * a)
 
 static void casef (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 631, 9, "casef", "case selector out of range");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 636, 9, "casef", "case selector out of range");
 }
 
 
@@ -749,7 +749,7 @@ static void casef (void * a)
 
 static void invalidloc (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 643, 9, "invalidloc", "invalid address referenced");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 648, 9, "invalidloc", "invalid address referenced");
 }
 
 
@@ -759,7 +759,7 @@ static void invalidloc (void * a)
 
 static void function (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 655, 9, "function", "... function ... ");  /* --fixme-- what has happened ?  */
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 660, 9, "function", "... function ... ");  /* --fixme-- what has happened ?  */
 }
 
 
@@ -769,7 +769,7 @@ static void function (void * a)
 
 static void wholevalue (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 667, 9, "wholevalue", "illegal whole value exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 672, 9, "wholevalue", "illegal whole value exception");
 }
 
 
@@ -779,7 +779,7 @@ static void wholevalue (void * a)
 
 static void wholediv (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 679, 9, "wholediv", "illegal whole value exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 684, 9, "wholediv", "illegal whole value exception");
 }
 
 
@@ -789,7 +789,7 @@ static void wholediv (void * a)
 
 static void realvalue (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 691, 9, "realvalue", "illegal real value exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 696, 9, "realvalue", "illegal real value exception");
 }
 
 
@@ -799,7 +799,7 @@ static void realvalue (void * a)
 
 static void realdiv (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 703, 9, "realdiv", "real number division by zero exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 708, 9, "realdiv", "real number division by zero exception");
 }
 
 
@@ -809,7 +809,7 @@ static void realdiv (void * a)
 
 static void complexvalue (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 715, 9, "complexvalue", "illegal complex value exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 720, 9, "complexvalue", "illegal complex value exception");
 }
 
 
@@ -819,7 +819,7 @@ static void complexvalue (void * a)
 
 static void complexdiv (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 727, 9, "complexdiv", "complex number division by zero exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 732, 9, "complexdiv", "complex number division by zero exception");
 }
 
 
@@ -829,7 +829,7 @@ static void complexdiv (void * a)
 
 static void protection (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 739, 9, "protection", "protection exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 744, 9, "protection", "protection exception");
 }
 
 
@@ -839,7 +839,7 @@ static void protection (void * a)
 
 static void systemf (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 751, 9, "systemf", "system exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 756, 9, "systemf", "system exception");
 }
 
 
@@ -849,7 +849,7 @@ static void systemf (void * a)
 
 static void coroutine (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 763, 9, "coroutine", "coroutine exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 768, 9, "coroutine", "coroutine exception");
 }
 
 
@@ -859,7 +859,7 @@ static void coroutine (void * a)
 
 static void exception (void * a)
 {
-  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 775, 9, "exception", "exception exception");
+  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 780, 9, "exception", "exception exception");
 }
 
 
@@ -925,14 +925,19 @@ void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, un
   addChar (':', &i);
   addNum (column, &i);
   addChar (':', &i);
-  addStr (message, &i);
   addChar (' ', &i);
-  addChar ('(', &i);
-  addChar ('i', &i);
+  addChar ('I', &i);
   addChar ('n', &i);
   addChar (' ', &i);
   addStr (function, &i);
-  addChar (')', &i);
+  addChar (ASCII_nl, &i);
+  addFile (file, &i);
+  addChar (':', &i);
+  addNum (line, &i);
+  addChar (':', &i);
+  addNum (column, &i);
+  addChar (':', &i);
+  addStr (message, &i);
   addChar (ASCII_nl, &i);
   addChar (ASCII_nul, &i);
   InvokeHandler ();
@@ -1173,7 +1178,7 @@ RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
 {
   if (currentEHB == NULL)
     {
-      M2RTS_Halt ((char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 84, 593, (char *) "GetBaseExceptionBlock", 21, (char *) "currentEHB has not been initialized yet", 39);
+      M2RTS_Halt ((char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 84, 598, (char *) "GetBaseExceptionBlock", 21, (char *) "currentEHB has not been initialized yet", 39);
     }
   else
     {
diff --git a/gcc/m2/mc-boot/GSArgs.c b/gcc/m2/mc-boot/GSArgs.c
index dd2565b8b2c..facba615ebf 100644
--- a/gcc/m2/mc-boot/GSArgs.c
+++ b/gcc/m2/mc-boot/GSArgs.c
@@ -88,7 +88,7 @@ unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int i)
   if (i < UnixArgs_ArgC)
     {
       /* ppc := ADDRESS (VAL (PtrToPtrToChar, ArgV) + (i * CARDINAL (TSIZE(PtrToChar)))) ;  */
-      ppc = (void *) (UnixArgs_ArgV+(i*sizeof (PtrToChar)));
+      ppc = (void *) (((PtrToChar) (UnixArgs_ArgV))+(i*sizeof (PtrToChar)));
       (*s) = DynamicStrings_InitStringCharStar ((void *) (*ppc));
       return TRUE;
     }
diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c
index 7a0865e2964..bf69ede7e3f 100644
--- a/gcc/m2/mc-boot/Gdecl.c
+++ b/gcc/m2/mc-boot/Gdecl.c
@@ -146,6 +146,7 @@ typedef struct StdIO_ProcRead_p StdIO_ProcRead;
 #   define caseException TRUE
 #   define returnException TRUE
 #   define forceCompoundStatement TRUE
+#   define enableDefForCStrings FALSE
 typedef struct intrinsicT_r intrinsicT;
 
 typedef struct fixupInfo_r fixupInfo;
@@ -358,6 +359,8 @@ struct libc_timeb_r {
                     };
 
 typedef int (*libc_exitP_t) (void);
+typedef libc_exitP_t libc_exitP_C;
+
 struct libc_exitP_p { libc_exitP_t proc; };
 
 struct _T8_r {
@@ -493,6 +496,7 @@ struct varparamT_r {
                      decl_node type;
                      decl_node scope;
                      unsigned int isUnbounded;
+                     unsigned int isForC;
                    };
 
 struct paramT_r {
@@ -500,6 +504,7 @@ struct paramT_r {
                   decl_node type;
                   decl_node scope;
                   unsigned int isUnbounded;
+                  unsigned int isForC;
                 };
 
 struct varargsT_r {
@@ -751,6 +756,7 @@ struct procedureT_r {
                       scopeT decls;
                       decl_node scope;
                       Indexing_Index parameters;
+                      unsigned int isForC;
                       unsigned int built;
                       unsigned int checking;
                       unsigned int returnopt;
@@ -2766,7 +2772,7 @@ int libc_shutdown (int s, int how);
 int libc_rename (void * oldpath, void * newpath);
 int libc_setjmp (void * env);
 void libc_longjmp (void * env, int val);
-int libc_atexit (libc_exitP proc);
+int libc_atexit (libc_exitP_C proc);
 void * libc_ttyname (int filedes);
 unsigned int libc_sleep (unsigned int seconds);
 void mcMetaError_metaError1 (char *m_, unsigned int _m_high, unsigned char *s_, unsigned int _s_high);
@@ -4388,6 +4394,12 @@ static void doParamConstCast (mcPretty_pretty p, decl_node n);
 
 static decl_node getParameterVariable (decl_node n, nameKey_Name m);
 
+/*
+   doParamTypeEmit -
+*/
+
+static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype);
+
 /*
    doParamC -
 */
@@ -5047,6 +5059,19 @@ static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_n
 
 static void emitN (mcPretty_pretty p, char *a_, unsigned int _a_high, unsigned int n);
 
+/*
+   isForC - return true if node n is a varparam, param or procedure
+            which was declared inside a definition module for "C".
+*/
+
+static unsigned int isForC (decl_node n);
+
+/*
+   isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
+*/
+
+static unsigned int isDefForCNode (decl_node n);
+
 /*
    doFuncParamC -
 */
@@ -6048,6 +6073,12 @@ static void outputHiddenComplete (decl_node n);
 
 static unsigned int tryPartial (decl_node n, nodeProcedure pt);
 
+/*
+   outputPartialRecordArrayProcType -
+*/
+
+static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection);
+
 /*
    outputPartial -
 */
@@ -7340,7 +7371,7 @@ static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type,
   n->recordfieldF.tag = FALSE;
   n->recordfieldF.scope = NULL;
   initCname (&n->recordfieldF.cname);
-  /* 
+  /*
    IF r^.kind=record
    THEN
       doRecordM2 (doP, r)
@@ -7752,7 +7783,7 @@ static decl_node makeIntrinsicProc (nodeT k, unsigned int noArgs, decl_node p)
 {
   decl_node f;
 
-  /* 
+  /*
    makeIntrisicProc -
   */
   f = newNode (k);
@@ -9146,7 +9177,7 @@ static void doIncludeC (decl_node n)
   DynamicStrings_String s;
 
   s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
-  if (isDefForC (n))
+  if (FALSE)  /* --fixme-- remove this clause when all regressions pass: isDefForC (n)  */
     {
       mcPretty_print (doP, (char *) "#   include \"mc-", 16);
       mcPretty_prints (doP, s);
@@ -9216,7 +9247,7 @@ static DynamicStrings_String getFQstring (decl_node n)
   DynamicStrings_String i;
   DynamicStrings_String s;
 
-  if (((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ())) || (isDefForC (decl_getScope (n))))
+  if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ()))  /* OR isDefForC (getScope (n))  */
     {
       return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
     }
@@ -10852,7 +10883,7 @@ static void doString (mcPretty_pretty p, decl_node n)
   s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
   outTextS (p, s);
   s = DynamicStrings_KillString (s);
-  /* 
+  /*
    IF DynamicStrings.Index (s, '"', 0)=-1
    THEN
       outText (p, '"') ;
@@ -11012,7 +11043,7 @@ static void doStringC (mcPretty_pretty p, decl_node n)
   DynamicStrings_String s;
 
   mcDebug_assert (isString (n));
-  /* 
+  /*
    s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
    IF DynamicStrings.Length (s)>3
    THEN
@@ -11505,6 +11536,25 @@ static decl_node getParameterVariable (decl_node n, nameKey_Name m)
 }
 
 
+/*
+   doParamTypeEmit -
+*/
+
+static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype)
+{
+  mcDebug_assert ((decl_isParam (paramnode)) || (decl_isVarParam (paramnode)));
+  if ((isForC (paramnode)) && (decl_isProcType (decl_skipType (paramtype))))
+    {
+      doFQNameC (p, paramtype);
+      outText (p, (char *) "_C", 2);
+    }
+  else
+    {
+      doTypeNameC (p, paramtype);
+    }
+}
+
+
 /*
    doParamC -
 */
@@ -11540,7 +11590,7 @@ static void doParamC (mcPretty_pretty p, decl_node n)
         {
           /* avoid dangling else.  */
           doParamConstCast (p, n);
-          doTypeNameC (p, ptype);
+          doParamTypeEmit (p, n, ptype);
           if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
             {
               outText (p, (char *) ",", 1);
@@ -11555,7 +11605,7 @@ static void doParamC (mcPretty_pretty p, decl_node n)
           while (c <= t)
             {
               doParamConstCast (p, n);
-              doTypeNameC (p, ptype);
+              doParamTypeEmit (p, n, ptype);
               i = wlists_getItemFromList (l, c);
               if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
                 {
@@ -11629,7 +11679,7 @@ static void doVarParamC (mcPretty_pretty p, decl_node n)
       l = n->varparamF.namelist->identlistF.names;
       if (l == NULL)
         {
-          doTypeNameC (p, ptype);
+          doParamTypeEmit (p, n, ptype);
         }
       else
         {
@@ -11637,7 +11687,7 @@ static void doVarParamC (mcPretty_pretty p, decl_node n)
           c = 1;
           while (c <= t)
             {
-              doTypeNameC (p, ptype);
+              doParamTypeEmit (p, n, ptype);
               if (! (decl_isArray (ptype)))
                 {
                   mcPretty_setNeedSpace (p);
@@ -12218,6 +12268,17 @@ static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node
       outText (p, (char *) "void", 4);
     }
   outText (p, (char *) ");\\n", 4);
+  if (isDefForCNode (n))
+    {
+      /* emit a C named type which differs from the m2 proctype.  */
+      outText (p, (char *) "typedef", 7);
+      mcPretty_setNeedSpace (p);
+      doFQNameC (p, t);
+      outText (p, (char *) "_t", 2);
+      mcPretty_setNeedSpace (p);
+      doFQNameC (p, t);
+      outText (p, (char *) "_C;\\n\\n", 7);
+    }
   outText (p, (char *) "struct", 6);
   mcPretty_setNeedSpace (p);
   doFQNameC (p, t);
@@ -12767,10 +12828,10 @@ static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m)
     {
       /* avoid dangling else.  */
       doFQNameC (p, n);
-      /* 
+      /*
    ELSIF isProcType (n) OR isArray (n) OR isRecord (n)
    THEN
-      HALT   n should have been simplified.  
+      HALT   n should have been simplified.
   */
       mcPretty_setNeedSpace (p);
     }
@@ -12996,7 +13057,7 @@ static void doExternCP (mcPretty_pretty p)
 
 static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s)
 {
-  /* remove 
+  /* remove
    from the start of the comment.  */
   while (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, 0)) == ASCII_lf))
     {
@@ -13224,13 +13285,10 @@ static void doPrototypeC (decl_node n)
 {
   if (! (decl_isExported (n)))
     {
-      if (! ((mcOptions_getExtendedOpaque ()) && (isDefForC (decl_getScope (n)))))
-        {
-          keyc_enterScope (n);
-          doProcedureHeadingC (n, TRUE);
-          mcPretty_print (doP, (char *) ";\\n", 3);
-          keyc_leaveScope (n);
-        }
+      keyc_enterScope (n);
+      doProcedureHeadingC (n, TRUE);
+      mcPretty_print (doP, (char *) ";\\n", 3);
+      keyc_leaveScope (n);
     }
 }
 
@@ -13722,7 +13780,7 @@ static void includeDefVarProcedure (decl_node n)
       defModule = decl_lookupDef (decl_getSymName (n));
       if (defModule != NULL)
         {
-          /* 
+          /*
          includeVar (defModule^.defF.decls) ;
          simplifyTypes (defModule^.defF.decls) ;
   */
@@ -14629,17 +14687,13 @@ static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node form
           outText (p, (char *) ".array[0]", 9);
         }
     }
-  /* --fixme-- isDefForC is not implemented yet.
-   IF NOT isDefForC (getScope (func))
-   THEN
-  */
-  outText (p, (char *) ",", 1);
-  mcPretty_setNeedSpace (p);
-  doFuncHighC (p, actual);
-  /* 
-   END
-  */
-  doTotype (p, actual, formal);
+  if (! (enableDefForCStrings && (isDefForC (decl_getScope (func)))))
+    {
+      outText (p, (char *) ",", 1);
+      mcPretty_setNeedSpace (p);
+      doFuncHighC (p, actual);
+      doTotype (p, actual, formal);
+    }
 }
 
 
@@ -14649,17 +14703,29 @@ static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node form
 
 static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal)
 {
-  outText (p, (char *) "(", 1);
-  doTypeNameC (p, decl_getType (formal));
-  outText (p, (char *) ")", 1);
-  mcPretty_setNeedSpace (p);
-  outText (p, (char *) "{", 1);
-  outText (p, (char *) "(", 1);
-  doFQNameC (p, decl_getType (formal));
-  outText (p, (char *) "_t)", 3);
-  mcPretty_setNeedSpace (p);
-  doExprC (p, actual);
-  outText (p, (char *) "}", 1);
+  if (isForC (formal))
+    {
+      outText (p, (char *) "(", 1);
+      doFQNameC (p, decl_getType (formal));
+      outText (p, (char *) "_C", 2);
+      outText (p, (char *) ")", 1);
+      mcPretty_setNeedSpace (p);
+      doExprC (p, actual);
+    }
+  else
+    {
+      outText (p, (char *) "(", 1);
+      doTypeNameC (p, decl_getType (formal));
+      outText (p, (char *) ")", 1);
+      mcPretty_setNeedSpace (p);
+      outText (p, (char *) "{", 1);
+      outText (p, (char *) "(", 1);
+      doFQNameC (p, decl_getType (formal));
+      outText (p, (char *) "_t)", 3);
+      mcPretty_setNeedSpace (p);
+      doExprC (p, actual);
+      outText (p, (char *) "}", 1);
+    }
 }
 
 
@@ -14807,6 +14873,56 @@ static void emitN (mcPretty_pretty p, char *a_, unsigned int _a_high, unsigned i
 }
 
 
+/*
+   isForC - return true if node n is a varparam, param or procedure
+            which was declared inside a definition module for "C".
+*/
+
+static unsigned int isForC (decl_node n)
+{
+  if (decl_isVarParam (n))
+    {
+      return n->varparamF.isForC;
+    }
+  else if (decl_isParam (n))
+    {
+      /* avoid dangling else.  */
+      return n->paramF.isForC;
+    }
+  else if (decl_isProcedure (n))
+    {
+      /* avoid dangling else.  */
+      return n->procedureF.isForC;
+    }
+  return FALSE;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
+*/
+
+static unsigned int isDefForCNode (decl_node n)
+{
+  nameKey_Name name;
+
+  while ((n != NULL) && (! (((decl_isImp (n)) || (decl_isDef (n))) || (decl_isModule (n)))))
+    {
+      n = decl_getScope (n);
+    }
+  if ((n != NULL) && (decl_isImp (n)))
+    {
+      name = decl_getSymName (n);
+      n = decl_lookupDef (name);
+    }
+  return ((n != NULL) && (decl_isDef (n))) && (isDefForC (n));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
 /*
    doFuncParamC -
 */
@@ -14841,6 +14957,24 @@ static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal,
                   doProcedureParamC (p, actual, formal);
                 }
             }
+          else if (((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && (isAProcType (ft))) && (isForC (formal)))
+            {
+              /* avoid dangling else.  */
+              if (decl_isVarParam (formal))
+                {
+                  mcMetaError_metaError2 ((char *) "{%1MDad} cannot be passed as a VAR parameter to the definition for C module as the parameter requires a cast to the formal type {%2MDtad}", 137, (unsigned char *) &actual, (sizeof (actual)-1), (unsigned char *) &formal, (sizeof (formal)-1));
+                }
+              else
+                {
+                  outText (p, (char *) "(", 1);
+                  doFQNameC (p, decl_getType (formal));
+                  outText (p, (char *) "_C", 2);
+                  outText (p, (char *) ")", 1);
+                  mcPretty_setNeedSpace (p);
+                  doExprC (p, actual);
+                  outText (p, (char *) ".proc", 5);
+                }
+            }
           else if ((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && ((decl_getType (actual)) != (decl_getType (formal))))
             {
               /* avoid dangling else.  */
@@ -15922,9 +16056,10 @@ static void doFuncExprC (mcPretty_pretty p, decl_node n)
     {
       outText (p, (char *) "(*", 2);
       doExprC (p, n->funccallF.function);
-      outText (p, (char *) ".proc)", 6);
-      mcPretty_setNeedSpace (p);
+      outText (p, (char *) ".proc", 5);
+      outText (p, (char *) ")", 1);
       t = getFuncFromExpr (n->funccallF.function);
+      mcPretty_setNeedSpace (p);
       if (t == procN)
         {
           doProcTypeArgsC (p, n, (Indexing_Index) NULL, TRUE);
@@ -19436,22 +19571,13 @@ static unsigned int tryPartial (decl_node n, nodeProcedure pt)
 
 
 /*
-   outputPartial -
+   outputPartialRecordArrayProcType -
 */
 
-static void outputPartial (decl_node n)
+static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection)
 {
   DynamicStrings_String s;
-  decl_node q;
-  unsigned int i;
 
-  q = decl_getType (n);
-  i = 0;
-  while (decl_isPointer (q))
-    {
-      q = decl_getType (q);
-      i += 1;
-    }
   outText (doP, (char *) "typedef struct", 14);
   mcPretty_setNeedSpace (doP);
   s = getFQstring (n);
@@ -19472,16 +19598,36 @@ static void outputPartial (decl_node n)
   outTextS (doP, s);
   mcPretty_setNeedSpace (doP);
   s = DynamicStrings_KillString (s);
-  while (i > 0)
+  while (indirection > 0)
     {
       outText (doP, (char *) "*", 1);
-      i -= 1;
+      indirection -= 1;
     }
   doFQNameC (doP, n);
   outText (doP, (char *) ";\\n\\n", 5);
 }
 
 
+/*
+   outputPartial -
+*/
+
+static void outputPartial (decl_node n)
+{
+  decl_node q;
+  unsigned int indirection;
+
+  q = decl_getType (n);
+  indirection = 0;
+  while (decl_isPointer (q))
+    {
+      q = decl_getType (q);
+      indirection += 1;
+    }
+  outputPartialRecordArrayProcType (n, q, indirection);
+}
+
+
 /*
    tryOutputTodo -
 */
@@ -22164,8 +22310,8 @@ decl_node decl_lookupModule (nameKey_Name n)
 
 void decl_putDefForC (decl_node n)
 {
-  /* --fixme-- currently disabled.  */
   mcDebug_assert (decl_isDef (n));
+  n->defF.forC = TRUE;
 }
 
 
@@ -24402,6 +24548,7 @@ decl_node decl_makeProcedure (nameKey_Name n)
       initDecls (&d->procedureF.decls);
       d->procedureF.scope = decl_getDeclScope ();
       d->procedureF.parameters = Indexing_InitIndex (1);
+      d->procedureF.isForC = isDefForCNode (decl_getDeclScope ());
       d->procedureF.built = FALSE;
       d->procedureF.returnopt = FALSE;
       d->procedureF.optarg_ = NULL;
@@ -24525,6 +24672,7 @@ decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc)
   d->varparamF.type = type;
   d->varparamF.scope = proc;
   d->varparamF.isUnbounded = FALSE;
+  d->varparamF.isForC = isDefForCNode (proc);
   return d;
   /* static analysis guarentees a RETURN statement will be used before here.  */
   __builtin_unreachable ();
@@ -24545,6 +24693,7 @@ decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc)
   d->paramF.type = type;
   d->paramF.scope = proc;
   d->paramF.isUnbounded = FALSE;
+  d->paramF.isForC = isDefForCNode (proc);
   return d;
   /* static analysis guarentees a RETURN statement will be used before here.  */
   __builtin_unreachable ();
@@ -24867,7 +25016,7 @@ decl_node decl_makeComponentRef (decl_node rec, decl_node field)
   decl_node n;
   decl_node a;
 
-  /* 
+  /*
    n := getLastOp (rec) ;
    IF (n#NIL) AND (isDeref (n) OR isPointerRef (n)) AND
       (skipType (getType (rec)) = skipType (getType (n)))
diff --git a/gcc/m2/mc-boot/Glibc.h b/gcc/m2/mc-boot/Glibc.h
index afd3149a1d9..355fbb70de0 100644
--- a/gcc/m2/mc-boot/Glibc.h
+++ b/gcc/m2/mc-boot/Glibc.h
@@ -80,6 +80,8 @@ struct libc_timeb_r {
                     };
 
 typedef int (*libc_exitP_t) (void);
+typedef libc_exitP_t libc_exitP_C;
+
 struct libc_exitP_p { libc_exitP_t proc; };
 
 EXTERN ssize_t libc_write (int d, void * buf, size_t nbytes);
@@ -279,6 +281,7 @@ EXTERN void * libc_memcpy (void * dest, void * src, size_t size);
    #include <string.h>
 
    void *memset(void *s, int c, size_t n);
+   It returns s.
 */
 
 EXTERN void * libc_memset (void * s, int c, size_t size);
@@ -376,7 +379,7 @@ EXTERN void libc_longjmp (void * env, int val);
    atexit - execute, proc, when the function exit is called.
 */
 
-EXTERN int libc_atexit (libc_exitP proc);
+EXTERN int libc_atexit (libc_exitP_C proc);
 
 /*
    ttyname - returns a pointer to a string determining the ttyname.
diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod
index d4758920fde..9c9f1638433 100644
--- a/gcc/m2/mc/decl.mod
+++ b/gcc/m2/mc/decl.mod
@@ -72,6 +72,7 @@ CONST
    returnException = TRUE ;
    (* this is a work around to avoid ever having to handle dangling else.  *)
    forceCompoundStatement = TRUE ;    (* TRUE will avoid dangling else, by always using {}.  *)
+   enableDefForCStrings   = FALSE ;   (* currently disabled.  *)
 
 
 TYPE
@@ -398,6 +399,7 @@ TYPE
                       type       :  node ;
 		      scope      :  node ;
                       isUnbounded:  BOOLEAN ;
+                      isForC     :  BOOLEAN ;
                    END ;
 
        paramT = RECORD
@@ -405,6 +407,7 @@ TYPE
                    type       :  node ;
                    scope      :  node ;
                    isUnbounded:  BOOLEAN ;
+                   isForC     :  BOOLEAN ;
                 END ;
 
        varargsT = RECORD
@@ -566,6 +569,7 @@ TYPE
                        decls          :  scopeT ;
                        scope          :  node ;
                        parameters     :  Index ;
+                       isForC,
 		       built,
 		       checking,
                        returnopt,
@@ -1498,9 +1502,8 @@ END makeModule ;
 
 PROCEDURE putDefForC (n: node) ;
 BEGIN
-   (* --fixme-- currently disabled.  *)
    assert (isDef (n)) ;
-   (* n^.defF.forC := TRUE *)
+   n^.defF.forC := TRUE
 END putDefForC ;
 
 
@@ -2132,6 +2135,7 @@ BEGIN
          initDecls (procedureF.decls) ;
          procedureF.scope := getDeclScope () ;
          procedureF.parameters := InitIndex (1) ;
+         procedureF.isForC := isDefForCNode (getDeclScope ()) ;
 	 procedureF.built := FALSE ;
          procedureF.returnopt := FALSE ;
          procedureF.optarg := NIL ;
@@ -2298,6 +2302,7 @@ BEGIN
    d^.paramF.type := type ;
    d^.paramF.scope := proc ;
    d^.paramF.isUnbounded := FALSE ;
+   d^.paramF.isForC := isDefForCNode (proc) ;
    RETURN d
 END makeNonVarParameter ;
 
@@ -2316,6 +2321,7 @@ BEGIN
    d^.varparamF.type := type ;
    d^.varparamF.scope := proc ;
    d^.varparamF.isUnbounded := FALSE ;
+   d^.varparamF.isForC := isDefForCNode (proc) ;
    RETURN d
 END makeVarParameter ;
 
@@ -5440,7 +5446,7 @@ VAR
    s: String ;
 BEGIN
    s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
-   IF isDefForC (n)
+   IF FALSE (* --fixme-- remove this clause when all regressions pass: isDefForC (n) *)
    THEN
       print (doP, '#   include "mc-') ;
       prints (doP, s) ;
@@ -5489,8 +5495,7 @@ PROCEDURE getFQstring (n: node) : String ;
 VAR
    i, s: String ;
 BEGIN
-   IF (NOT isExported (n)) OR
-      getIgnoreFQ () OR isDefForC (getScope (n))
+   IF (NOT isExported (n)) OR getIgnoreFQ () (* OR isDefForC (getScope (n)) *)
    THEN
       RETURN InitStringCharStar (keyToCharStar (getSymName (n)))
    ELSE
@@ -7086,6 +7091,23 @@ BEGIN
 END getParameterVariable ;
 
 
+(*
+   doParamTypeEmit -
+*)
+
+PROCEDURE doParamTypeEmit (p: pretty; paramnode, paramtype: node) ;
+BEGIN
+   assert (isParam (paramnode) OR isVarParam (paramnode)) ;
+   IF isForC (paramnode) AND isProcType (skipType (paramtype))
+   THEN
+      doFQNameC (p, paramtype) ;
+      outText (p, "_C")
+   ELSE
+      doTypeNameC (p, paramtype)
+   END
+END doParamTypeEmit ;
+
+
 (*
    doParamC -
 *)
@@ -7115,7 +7137,7 @@ BEGIN
       IF l=NIL
       THEN
          doParamConstCast (p, n) ;
-         doTypeNameC (p, ptype) ;
+         doParamTypeEmit (p, n, ptype) ;
          IF isArray (ptype) AND isUnbounded (ptype)
          THEN
             outText (p, ',') ; setNeedSpace (p) ;
@@ -7126,7 +7148,7 @@ BEGIN
          c := 1 ;
          WHILE c <= t DO
             doParamConstCast (p, n) ;
-            doTypeNameC (p, ptype) ;
+            doParamTypeEmit (p, n, ptype) ;
             i := wlists.getItemFromList (l, c) ;
             IF isArray (ptype) AND isUnbounded (ptype)
             THEN
@@ -7190,12 +7212,12 @@ BEGIN
       l := n^.varparamF.namelist^.identlistF.names ;
       IF l=NIL
       THEN
-         doTypeNameC (p, ptype)
+         doParamTypeEmit (p, n, ptype)
       ELSE
          t := wlists.noOfItemsInList (l) ;
          c := 1 ;
          WHILE c <= t DO
-            doTypeNameC (p, ptype) ;
+            doParamTypeEmit (p, n, ptype) ;
 	    IF NOT isArray (ptype)
             THEN
                setNeedSpace (p) ;
@@ -7660,6 +7682,15 @@ BEGIN
       outText (p, "void")
    END ;
    outText (p, ");\n") ;
+   IF isDefForCNode (n)
+   THEN
+      (* emit a C named type which differs from the m2 proctype.  *)
+      outText (p, "typedef") ; setNeedSpace (p) ;
+      doFQNameC (p, t) ;
+      outText (p, "_t") ; setNeedSpace (p) ;
+      doFQNameC (p, t) ;
+      outText (p, "_C;\n\n")
+   END ;
    outText (p, "struct") ; setNeedSpace (p) ;
    doFQNameC (p, t) ;
    outText (p, "_p {") ; setNeedSpace (p) ;
@@ -8424,13 +8455,10 @@ PROCEDURE doPrototypeC (n: node) ;
 BEGIN
    IF NOT isExported (n)
    THEN
-      IF NOT (getExtendedOpaque () AND isDefForC (getScope (n)))
-      THEN
-         keyc.enterScope (n) ;
-         doProcedureHeadingC (n, TRUE) ;
-         print (doP, ";\n") ;
-         keyc.leaveScope (n)
-      END
+      keyc.enterScope (n) ;
+      doProcedureHeadingC (n, TRUE) ;
+      print (doP, ";\n") ;
+      keyc.leaveScope (n)
    END
 END doPrototypeC ;
 
@@ -9713,17 +9741,13 @@ BEGIN
          outText (p, '.array[0]')
       END
    END ;
-(* --fixme-- isDefForC is not implemented yet.
-   IF NOT isDefForC (getScope (func))
+   IF NOT (enableDefForCStrings AND isDefForC (getScope (func)))
    THEN
-*)
       outText (p, ',') ;
       setNeedSpace (p) ;
       doFuncHighC (p, actual) ;
       doTotype (p, actual, formal)
-(*
    END
-*)
 END doFuncUnbounded ;
 
 
@@ -9733,17 +9757,27 @@ END doFuncUnbounded ;
 
 PROCEDURE doProcedureParamC (p: pretty; actual, formal: node) ;
 BEGIN
-   outText (p, '(') ;
-   doTypeNameC (p, getType (formal)) ;
-   outText (p, ')') ;
-   setNeedSpace (p) ;
-   outText (p, '{') ;
-   outText (p, '(') ;
-   doFQNameC (p, getType (formal)) ;
-   outText (p, '_t)') ;
-   setNeedSpace (p) ;
-   doExprC (p, actual) ;
-   outText (p, '}')
+   IF isForC (formal)
+   THEN
+      outText (p, '(') ;
+      doFQNameC (p, getType (formal)) ;
+      outText (p, "_C") ;
+      outText (p, ')') ;
+      setNeedSpace (p) ;
+      doExprC (p, actual)
+   ELSE
+      outText (p, '(') ;
+      doTypeNameC (p, getType (formal)) ;
+      outText (p, ')') ;
+      setNeedSpace (p) ;
+      outText (p, '{') ;
+      outText (p, '(') ;
+      doFQNameC (p, getType (formal)) ;
+      outText (p, '_t)') ;
+      setNeedSpace (p) ;
+      doExprC (p, actual) ;
+      outText (p, '}')
+    END
 END doProcedureParamC ;
 
 
@@ -9874,6 +9908,47 @@ BEGIN
 END emitN ;
 
 
+(*
+   isForC - return true if node n is a varparam, param or procedure
+            which was declared inside a definition module for "C".
+*)
+
+PROCEDURE isForC (n: node) : BOOLEAN ;
+BEGIN
+   IF isVarParam (n)
+   THEN
+      RETURN n^.varparamF.isForC
+   ELSIF isParam (n)
+   THEN
+      RETURN n^.paramF.isForC
+   ELSIF isProcedure (n)
+   THEN
+      RETURN n^.procedureF.isForC
+   END ;
+   RETURN FALSE
+END isForC ;
+
+
+(*
+   isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
+*)
+
+PROCEDURE isDefForCNode (n: node) : BOOLEAN ;
+VAR
+   name: Name ;
+BEGIN
+   WHILE (n # NIL) AND (NOT (isImp (n) OR isDef (n) OR isModule (n))) DO
+      n := getScope (n)
+   END ;
+   IF (n # NIL) AND isImp (n)
+   THEN
+      name := getSymName (n) ;
+      n := lookupDef (name) ;
+   END ;
+   RETURN (n # NIL) AND isDef (n) AND isDefForC (n)
+END isDefForCNode ;
+
+
 (*
    doFuncParamC -
 *)
@@ -9900,6 +9975,21 @@ BEGIN
             ELSE
                doProcedureParamC (p, actual, formal)
             END
+         ELSIF (getType (actual) # NIL) AND isProcType (skipType (getType (actual))) AND isAProcType (ft) AND isForC (formal)
+         THEN
+            IF isVarParam (formal)
+            THEN
+               metaError2 ('{%1MDad} cannot be passed as a VAR parameter to the definition for C module as the parameter requires a cast to the formal type {%2MDtad}',
+                           actual, formal)
+            ELSE
+               outText (p, '(') ;
+               doFQNameC (p, getType (formal)) ;
+               outText (p, "_C") ;
+               outText (p, ')') ;
+               setNeedSpace (p) ;
+               doExprC (p, actual) ;
+               outText (p, ".proc")
+            END
          ELSIF (getType (actual) # NIL) AND isProcType (skipType (getType (actual))) AND (getType (actual) # getType (formal))
          THEN
             IF isVarParam (formal)
@@ -10814,9 +10904,10 @@ BEGIN
    ELSE
       outText (p, "(*") ;
       doExprC (p, n^.funccallF.function) ;
-      outText (p, ".proc)") ;
-      setNeedSpace (p) ;
+      outText (p, ".proc") ;
+      outText (p, ")") ;
       t := getFuncFromExpr (n^.funccallF.function) ;
+      setNeedSpace (p) ;
       IF t = procN
       THEN
          doProcTypeArgsC (p, n, NIL, TRUE)
@@ -13615,21 +13706,13 @@ END tryPartial ;
 
 
 (*
-   outputPartial -
+   outputPartialRecordArrayProcType -
 *)
 
-PROCEDURE outputPartial (n: node) ;
+PROCEDURE outputPartialRecordArrayProcType (n, q: node; indirection: CARDINAL) ;
 VAR
    s: String ;
-   q: node ;
-   i: CARDINAL ;
 BEGIN
-   q := getType (n) ;
-   i := 0 ;
-   WHILE isPointer (q) DO
-      q := getType (q) ;
-      INC (i)
-   END ;
    outText (doP, "typedef struct") ; setNeedSpace (doP) ;
    s := getFQstring (n) ;
    IF isRecord (q)
@@ -13645,12 +13728,31 @@ BEGIN
    outTextS (doP, s) ;
    setNeedSpace (doP) ;
    s := KillString (s) ;
-   WHILE i>0 DO
+   WHILE indirection>0 DO
       outText (doP, "*") ;
-      DEC (i)
+      DEC (indirection)
    END ;
    doFQNameC (doP, n) ;
    outText (doP, ";\n\n")
+END outputPartialRecordArrayProcType ;
+
+
+(*
+   outputPartial -
+*)
+
+PROCEDURE outputPartial (n: node) ;
+VAR
+   q          : node ;
+   indirection: CARDINAL ;
+BEGIN
+   q := getType (n) ;
+   indirection := 0 ;
+   WHILE isPointer (q) DO
+      q := getType (q) ;
+      INC (indirection)
+   END ;
+   outputPartialRecordArrayProcType (n, q, indirection)
 END outputPartial ;


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2021-12-30 20:44 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-12-30 20:44 [gcc/devel/modula-2] Fixes to bootstrap resulting in m2 lto building/passing regression tests [PR93575] Gaius Mulley

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).