[gcc/devel/modula-2] PR-105388 Fix mc to avoid library name trunc.

[gcc/devel/modula-2] PR-105388 Fix mc to avoid library name trunc.

[Gaius Mulley]

https://gcc.gnu.org/g:9348eb1ddb17e8b59a4b54cb341bd7641f67dc58

commit 9348eb1ddb17e8b59a4b54cb341bd7641f67dc58
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date:   Thu Apr 28 18:37:47 2022 +0100

    PR-105388 Fix mc to avoid library name trunc.
    
    2022-04-28   Gaius Mulley   <gaius.mulley@southwales.ac.uk>
    
    gcc/m2/ChangeLog:
    
            * m2/mc-boot/GEnvironment.c: Rebuilt.
            * mc-boot/GEnvironment.h: Rebuilt.
            * mc-boot/Gdecl.c: Rebuilt.
            * mc-boot/Gkeyc.c: Rebuilt.
            * mc-boot/Glibc.h: Rebuilt.
            * mc/keyc.mod (initMacros): Add trunc to the list of functions to
            be avoided.
    
    Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>

Diff:
---
 gcc/m2/mc-boot/GEnvironment.c | 49 +++++++++++++++++++++++++++++++++++--------
 gcc/m2/mc-boot/GEnvironment.h | 16 +++++++++++---
 gcc/m2/mc-boot/Gdecl.c        | 42 +++++++++++++++++++------------------
 gcc/m2/mc-boot/Gkeyc.c        |  1 +
 gcc/m2/mc-boot/Glibc.h        | 12 +++++++++++
 gcc/m2/mc/keyc.mod            |  1 +
 6 files changed, 89 insertions(+), 32 deletions(-)

diff --git a/gcc/m2/mc-boot/GEnvironment.c b/gcc/m2/mc-boot/GEnvironment.c
index d79022e3cb9..ea0a6cbf21e 100644
--- a/gcc/m2/mc-boot/GEnvironment.c
+++ b/gcc/m2/mc-boot/GEnvironment.c
@@ -47,19 +47,31 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 
 /*
-   GetEnvironment - gets the environment variable, Env, and places
-      	       	    a copy of its value into string, a.
+   GetEnvironment - gets the environment variable Env and places
+      	       	    a copy of its value into string, dest.
+                    It returns TRUE if the string Env was found in
+                    the processes environment.
 */
 
-extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *a, unsigned int _a_high);
+extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high);
+
+/*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*/
+
+extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high);
 
 
 /*
-   GetEnvironment - gets the environment variable, Env, and places
-      	       	    a copy of its value into string, a.
+   GetEnvironment - gets the environment variable Env and places
+      	       	    a copy of its value into string, dest.
+                    It returns TRUE if the string Env was found in
+                    the processes environment.
 */
 
-extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *a, unsigned int _a_high)
+extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high)
 {
   typedef char *_T1;
 
@@ -72,23 +84,42 @@ extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned i
   memcpy (Env, Env_, _Env_high+1);
 
   i = 0;
-  High = _a_high;
+  High = _dest_high;
   Addr = static_cast<_T1> (libc_getenv (&Env));
   while (((i < High) && (Addr != NULL)) && ((*Addr) != ASCII_nul))
     {
-      a[i] = (*Addr);
+      dest[i] = (*Addr);
       Addr += 1;
       i += 1;
     }
   if (i < High)
     {
-      a[i] = ASCII_nul;
+      dest[i] = ASCII_nul;
     }
   return Addr != NULL;
   /* static analysis guarentees a RETURN statement will be used before here.  */
   __builtin_unreachable ();
 }
 
+
+/*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*/
+
+extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high)
+{
+  char EnvDef[_EnvDef_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (EnvDef, EnvDef_, _EnvDef_high+1);
+
+  return (libc_putenv (&EnvDef)) == 0;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
 extern "C" void _M2_Environment_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
 {
 }
diff --git a/gcc/m2/mc-boot/GEnvironment.h b/gcc/m2/mc-boot/GEnvironment.h
index 6c662aab457..16701450da5 100644
--- a/gcc/m2/mc-boot/GEnvironment.h
+++ b/gcc/m2/mc-boot/GEnvironment.h
@@ -49,11 +49,21 @@ extern "C" {
 
 
 /*
-   GetEnvironment - gets the environment variable, Env, and places
-      	       	    a copy of its value into string, a.
+   GetEnvironment - gets the environment variable Env and places
+      	       	    a copy of its value into string, dest.
+                    It returns TRUE if the string Env was found in
+                    the processes environment.
 */
 
-EXTERN unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *a, unsigned int _a_high);
+EXTERN unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high);
+
+/*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*/
+
+EXTERN unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high);
 #   ifdef __cplusplus
 }
 #   endif
diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c
index 3c7296364c0..5c24956d1e8 100644
--- a/gcc/m2/mc-boot/Gdecl.c
+++ b/gcc/m2/mc-boot/Gdecl.c
@@ -267,7 +267,7 @@ typedef struct _T5_r _T5;
 
 #   define MaxBuf 127
 #   define maxNoOfElements 5
-typedef enum {explist, funccall, exit_, return_, stmtseq, comment, halt, new_, dispose, inc, dec, incl, excl, length, nil, true_, false_, address, loc, byte, word, csizet, cssizet, char_, cardinal, longcard, shortcard, integer, longint, shortint, real, longreal, shortreal, bitset, boolean, proc, ztype, rtype, complex_, longcomplex, shortcomplex, type, record, varient, var, enumeration, subrange, array, subscript, string, const_, literal, varparam, param, varargs, optarg_, pointer, recordfield, varientfield, enumerationfield, set, proctype, procedure, def, imp, module, loop, while_, for_, repeat, case_, caselabellist, caselist, range, assignment, if_, elsif, constexp, neg, cast, val, plus, sub, div_, mod, mult, divide, in, adr, size, tsize, ord, float_, trunc, chr, abs_, cap, high, throw_, unreachable, cmplx, re, im, min, max, componentref, pointerref, arrayref, deref, equal, notequal, less, greater, greequal, lessequal, lsl, lsr, lor, land, lnot, lxor, and_, or_, not_, identlist, vardecl, setvalue} nodeT;
+typedef enum {explist, funccall, exit_, return_, stmtseq, comment, halt, new_, dispose, inc, dec, incl, excl, length, nil, true_, false_, address, loc, byte, word, csizet, cssizet, char_, cardinal, longcard, shortcard, integer, longint, shortint, real, longreal, shortreal, bitset, boolean, proc, ztype, rtype, complex_, longcomplex, shortcomplex, type, record, varient, var, enumeration, subrange, array, subscript, string, const_, literal, varparam, param, varargs, optarg_, pointer, recordfield, varientfield, enumerationfield, set, proctype, procedure, def, imp, module, loop, while_, for_, repeat, case_, caselabellist, caselist, range, assignment, if_, elsif, constexp, neg, cast, val, plus, sub, div_, mod, mult, divide, in, adr, size, tsize, ord, float_, trunc_, chr, abs_, cap, high, throw_, unreachable, cmplx, re, im, min, max, componentref, pointerref, arrayref, deref, equal, notequal, less, greater, greequal, lessequal, lsl, lsr, lor, land, lnot, lxor, and_, or_, not_, identlist, vardecl, setvalue} nodeT;
 
 #   define MaxnoOfelements 5
 typedef enum {mcReserved_eoftok, mcReserved_plustok, mcReserved_minustok, mcReserved_timestok, mcReserved_dividetok, mcReserved_becomestok, mcReserved_ambersandtok, mcReserved_periodtok, mcReserved_commatok, mcReserved_semicolontok, mcReserved_lparatok, mcReserved_rparatok, mcReserved_lsbratok, mcReserved_rsbratok, mcReserved_lcbratok, mcReserved_rcbratok, mcReserved_uparrowtok, mcReserved_singlequotetok, mcReserved_equaltok, mcReserved_hashtok, mcReserved_lesstok, mcReserved_greatertok, mcReserved_lessgreatertok, mcReserved_lessequaltok, mcReserved_greaterequaltok, mcReserved_ldirectivetok, mcReserved_rdirectivetok, mcReserved_periodperiodtok, mcReserved_colontok, mcReserved_doublequotestok, mcReserved_bartok, mcReserved_andtok, mcReserved_arraytok, mcReserved_begintok, mcReserved_bytok, mcReserved_casetok, mcReserved_consttok, mcReserved_definitiontok, mcReserved_divtok, mcReserved_dotok, mcReserved_elsetok, mcReserved_elsiftok, mcReserved_endtok, mcReserved_excepttok, mcReserved_exittok, mcReserved_exporttok, mcReserved_finallytok, mcReserved_fortok, mcReserved_fromtok, mcReserved_iftok, mcReserved_implementationtok, mcReserved_importtok, mcReserved_intok, mcReserved_looptok, mcReserved_modtok, mcReserved_moduletok, mcReserved_nottok, mcReserved_oftok, mcReserved_ortok, mcReserved_packedsettok, mcReserved_pointertok, mcReserved_proceduretok, mcReserved_qualifiedtok, mcReserved_unqualifiedtok, mcReserved_recordtok, mcReserved_remtok, mcReserved_repeattok, mcReserved_retrytok, mcReserved_returntok, mcReserved_settok, mcReserved_thentok, mcReserved_totok, mcReserved_typetok, mcReserved_untiltok, mcReserved_vartok, mcReserved_whiletok, mcReserved_withtok, mcReserved_asmtok, mcReserved_volatiletok, mcReserved_periodperiodperiodtok, mcReserved_datetok, mcReserved_linetok, mcReserved_filetok, mcReserved_attributetok, mcReserved_builtintok, mcReserved_inlinetok, mcReserved_integertok, mcReserved_identtok, mcReserved_realtok, mcReserved_stringtok, mcReserved_commenttok} mcReserved_toktype;
@@ -2745,6 +2745,7 @@ extern "C" void * libc_realloc (void * ptr, size_t size);
 extern "C" int libc_isatty (int fd);
 extern "C" void libc_exit (int r) __attribute__ ((noreturn));
 extern "C" void * libc_getenv (void * s);
+extern "C" int libc_putenv (void * s);
 extern "C" int libc_getpid (void);
 extern "C" int libc_dup (int d);
 extern "C" int libc_close (int d);
@@ -2777,6 +2778,7 @@ extern "C" void libc_longjmp (void * env, int val);
 extern "C" int libc_atexit (libc_exitP_C proc);
 extern "C" void * libc_ttyname (int filedes);
 extern "C" unsigned int libc_sleep (unsigned int seconds);
+extern "C" int libc_execv (void * pathname, void * argv);
 extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
 extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
 extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
@@ -7037,7 +7039,7 @@ static void setUnary (decl_node u, nodeT k, decl_node a, decl_node t)
       case cap:
       case abs_:
       case float_:
-      case trunc:
+      case trunc_:
       case ord:
       case high:
       case throw_:
@@ -7920,7 +7922,7 @@ static decl_node checkIntrinsic (decl_node c, decl_node n)
   else if (c == truncN)
     {
       /* avoid dangling else.  */
-      return makeIntrinsicUnaryType (trunc, n, integerN);
+      return makeIntrinsicUnaryType (trunc_, n, integerN);
     }
   else if (c == ordN)
     {
@@ -8221,7 +8223,7 @@ static unsigned int isUnary (decl_node n)
       case abs_:
       case ord:
       case float_:
-      case trunc:
+      case trunc_:
       case constexp:
       case not_:
       case neg:
@@ -8314,7 +8316,7 @@ static decl_node makeUnary (nodeT k, decl_node e, decl_node res)
           case abs_:
           case ord:
           case float_:
-          case trunc:
+          case trunc_:
           case length:
           case constexp:
           case not_:
@@ -8678,7 +8680,7 @@ static decl_node makeBase (nodeT k)
       case cap:
       case abs_:
       case float_:
-      case trunc:
+      case trunc_:
       case ord:
       case high:
       case throw_:
@@ -9114,7 +9116,7 @@ static decl_node doGetExprType (decl_node n)
         return doSetExprType (&n->unaryF.resultType, realN);
         break;
 
-      case trunc:
+      case trunc_:
         return doSetExprType (&n->unaryF.resultType, integerN);
         break;
 
@@ -9452,7 +9454,7 @@ static unsigned int needsParen (decl_node n)
       case tsize:
       case ord:
       case float_:
-      case trunc:
+      case trunc_:
       case chr:
       case cap:
       case high:
@@ -9844,7 +9846,7 @@ static decl_node doGetLastOp (decl_node a, decl_node b)
         break;
 
       case float_:
-      case trunc:
+      case trunc_:
         return doGetLastOp (b, b->unaryF.arg);
         break;
 
@@ -10425,7 +10427,7 @@ static void doExprC (mcPretty_pretty p, decl_node n)
         doConvertC (p, n, (const char *) "(double)", 8);
         break;
 
-      case trunc:
+      case trunc_:
         doConvertC (p, n, (const char *) "(int)", 5);
         break;
 
@@ -10710,7 +10712,7 @@ static void doExprM2 (mcPretty_pretty p, decl_node n)
         doUnary (p, (const char *) "FLOAT", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
         break;
 
-      case trunc:
+      case trunc_:
         doUnary (p, (const char *) "TRUNC", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
         break;
 
@@ -16107,7 +16109,7 @@ static unsigned int isIntrinsicFunction (decl_node n)
       case size:
       case tsize:
       case float_:
-      case trunc:
+      case trunc_:
       case ord:
       case chr:
       case cap:
@@ -18093,7 +18095,7 @@ static dependentState doDependants (alists_alist l, decl_node n)
       case cap:
       case ord:
       case float_:
-      case trunc:
+      case trunc_:
       case high:
         return walkUnary (l, n);
         break;
@@ -19152,7 +19154,7 @@ static void visitDependants (alists_alist v, decl_node n, nodeProcedure p)
         visitUnary (v, n, p);
         break;
 
-      case trunc:
+      case trunc_:
         visitUnary (v, n, p);
         break;
 
@@ -19458,7 +19460,7 @@ static DynamicStrings_String genKind (decl_node n)
         return DynamicStrings_InitString ((const char *) "float", 5);
         break;
 
-      case trunc:
+      case trunc_:
         return DynamicStrings_InitString ((const char *) "trunc", 5);
         break;
 
@@ -21798,7 +21800,7 @@ static decl_node doDupExpr (decl_node n)
       case cap:
       case high:
       case float_:
-      case trunc:
+      case trunc_:
       case ord:
       case not_:
       case neg:
@@ -21936,7 +21938,7 @@ static void makeBaseSymbols (void)
   minN = makeBase (min);
   maxN = makeBase (max);
   floatN = makeBase (float_);
-  truncN = makeBase (trunc);
+  truncN = makeBase (trunc_);
   ordN = makeBase (ord);
   valN = makeBase (val);
   chrN = makeBase (chr);
@@ -22825,7 +22827,7 @@ extern "C" decl_node decl_getType (decl_node n)
         return booleanN;
         break;
 
-      case trunc:
+      case trunc_:
         return integerN;
         break;
 
@@ -23185,7 +23187,7 @@ extern "C" decl_node decl_getScope (decl_node n)
       case cap:
       case ord:
       case float_:
-      case trunc:
+      case trunc_:
       case high:
       case cast:
       case val:
@@ -24342,7 +24344,7 @@ extern "C" nameKey_Name decl_getSymName (decl_node n)
         return nameKey_makeKey ((const char *) "FLOAT", 5);
         break;
 
-      case trunc:
+      case trunc_:
         return nameKey_makeKey ((const char *) "TRUNC", 5);
         break;
 
diff --git a/gcc/m2/mc-boot/Gkeyc.c b/gcc/m2/mc-boot/Gkeyc.c
index eaeba550732..d1deb222a5a 100644
--- a/gcc/m2/mc-boot/Gkeyc.c
+++ b/gcc/m2/mc-boot/Gkeyc.c
@@ -982,6 +982,7 @@ static void initMacros (void)
   add (macros, (const char *) "cos", 3);
   add (macros, (const char *) "tan", 3);
   add (macros, (const char *) "log10", 5);
+  add (macros, (const char *) "trunc", 5);
   add (macros, (const char *) "I", 1);
   add (macros, (const char *) "csqrt", 5);
   add (macros, (const char *) "strlen", 6);
diff --git a/gcc/m2/mc-boot/Glibc.h b/gcc/m2/mc-boot/Glibc.h
index 2e461b437ae..ad4197066cc 100644
--- a/gcc/m2/mc-boot/Glibc.h
+++ b/gcc/m2/mc-boot/Glibc.h
@@ -149,6 +149,12 @@ EXTERN void libc_exit (int r) __attribute__ ((noreturn));
 
 EXTERN void * libc_getenv (void * s);
 
+/*
+   putenv - change or add an environment variable.
+*/
+
+EXTERN int libc_putenv (void * s);
+
 /*
    getpid - returns the UNIX process identification number.
 */
@@ -392,6 +398,12 @@ EXTERN void * libc_ttyname (int filedes);
 */
 
 EXTERN unsigned int libc_sleep (unsigned int seconds);
+
+/*
+   execv - execute a file.
+*/
+
+EXTERN int libc_execv (void * pathname, void * argv);
 #   ifdef __cplusplus
 }
 #   endif
diff --git a/gcc/m2/mc/keyc.mod b/gcc/m2/mc/keyc.mod
index 2cf06790d93..a6584f49a9f 100644
--- a/gcc/m2/mc/keyc.mod
+++ b/gcc/m2/mc/keyc.mod
@@ -1033,6 +1033,7 @@ BEGIN
    add (macros, 'cos') ;
    add (macros, 'tan') ;
    add (macros, 'log10') ;
+   add (macros, 'trunc') ;
    add (macros, 'I') ;
    add (macros, 'csqrt') ;
    add (macros, 'strlen') ;