public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Bugfix mc memset correction, correct comments and add options to mc.
@ 2022-09-06 23:06 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-09-06 23:06 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:ae6d944ee86c168ca0561914b8d486a50dcb8bb7
commit ae6d944ee86c168ca0561914b8d486a50dcb8bb7
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Wed Sep 7 00:06:31 2022 +0100
Bugfix mc memset correction, correct comments and add options to mc.
gcc/m2/ChangeLog:
* gm2-compiler/M2Quads.mod: Correct init/fini function names
in comments relating to intemediate code.
* m2/mc/decl.mod (nodeRec): Introduced. (newNode) Call
memset with SIZE (d^) as a parameter.
(scaffoldStatic) New procedure. (emitCtor) New procedure.
(scaffoldDynamic) New procedure. (scaffoldMain) New procedure.
(outImpInitC) Rewritten.
* mc/mcOptions.def (getScaffoldStatic) New definition.
(getScaffoldDynamic) New definition.
(getScaffoldMain) New definition.
* mc/mcOptions.mod (getScaffoldStatic) New procedure function.
(getScaffoldDynamic) New procedure function.
(getScaffoldMain) New definition function.
* mc-boot/Gdecl.c: Rebuilt.
* mc-boot/GmcOptions.c: Rebuilt.
* mc-boot/GmcOptions.h: Rebuilt.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Quads.mod | 6 +-
gcc/m2/mc-boot/Gdecl.c | 361 +++++++++++++++++++++++++++++-----------
gcc/m2/mc-boot/GmcOptions.c | 52 ++++++
gcc/m2/mc-boot/GmcOptions.h | 12 ++
gcc/m2/mc/decl.mod | 148 +++++++++++++++-
gcc/m2/mc/mcOptions.def | 14 ++
gcc/m2/mc/mcOptions.mod | 32 ++++
7 files changed, 517 insertions(+), 108 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index a51f80cde2d..a22a777fcd8 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -2424,8 +2424,8 @@ BEGIN
int
main (int argc, char *argv[], char *envp[])
{
- init (argc, argv, envp);
- finish ();
+ _M2_init (argc, argv, envp);
+ _M2_fini (argc, argv, envp);
return 0;
}
*)
@@ -2442,7 +2442,7 @@ BEGIN
PushT (3) ;
BuildProcedureCall (tokno) ;
- (* _M2_finish (argc, argv, envp); *)
+ (* _M2_fini (argc, argv, envp); *)
PushTtok (finiFunction, tokno) ;
PushTtok (RequestSym (tokno, MakeKey ("argc")), tokno) ;
PushTtok (RequestSym (tokno, MakeKey ("argv")), tokno) ;
diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c
index e18842adb0b..b9fd0fa1950 100644
--- a/gcc/m2/mc-boot/Gdecl.c
+++ b/gcc/m2/mc-boot/Gdecl.c
@@ -47,9 +47,9 @@ typedef unsigned int nameKey_Name;
# define nameKey_NulName 0
typedef struct mcPretty_writeProc_p mcPretty_writeProc;
-typedef struct _T9_r _T9;
+typedef struct _T8_r _T8;
-typedef _T9 *symbolKey_symbolTree;
+typedef _T8 *symbolKey_symbolTree;
typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc;
@@ -59,11 +59,11 @@ extern FIO_File FIO_StdOut;
typedef struct symbolKey_performOperation_p symbolKey_performOperation;
# define ASCII_tab ASCII_ht
-typedef struct _T14_r _T14;
+typedef struct _T13_r _T13;
-typedef _T14 *alists_alist;
+typedef _T13 *alists_alist;
-typedef struct _T15_a _T15;
+typedef struct _T14_a _T14;
# define ASCII_ht (char) 011
# define ASCII_lf ASCII_nl
@@ -126,9 +126,9 @@ typedef struct libc_timeb_r libc_timeb;
typedef struct libc_exitP_p libc_exitP;
-typedef struct _T12_r _T12;
+typedef struct _T11_r _T11;
-typedef _T12 *mcError_error;
+typedef _T11 *mcError_error;
extern int mcLexBuf_currentinteger;
extern unsigned int mcLexBuf_currentcolumn;
@@ -149,6 +149,9 @@ typedef struct StdIO_ProcRead_p StdIO_ProcRead;
# define returnException TRUE
# define forceCompoundStatement TRUE
# define enableDefForCStrings FALSE
+# define enableMemsetOnAllocation TRUE
+typedef struct nodeRec_r nodeRec;
+
typedef struct intrinsicT_r intrinsicT;
typedef struct fixupInfo_r fixupInfo;
@@ -265,8 +268,6 @@ typedef struct nodeProcedure_p nodeProcedure;
typedef struct cnameT_r cnameT;
-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;
@@ -281,42 +282,42 @@ typedef enum {completed, blocked, partial, recursive} dependentState;
typedef enum {text, punct, space} outputStates;
-typedef _T5 *decl_node;
+typedef nodeRec *decl_node;
-typedef struct _T6_r _T6;
+typedef struct _T5_r _T5;
-typedef struct _T7_r _T7;
+typedef struct _T6_r _T6;
typedef enum {unknown, procedureHeading, inBody, afterStatement} commentType;
typedef struct stringRecord_r stringRecord;
-typedef struct _T10_r _T10;
+typedef struct _T9_r _T9;
-typedef struct _T13_r _T13;
+typedef struct _T12_r _T12;
typedef struct Contents_r Contents;
-typedef struct _T8_a _T8;
+typedef struct _T7_a _T7;
-typedef struct _T11_a _T11;
+typedef struct _T10_a _T10;
-typedef _T6 *Indexing_Index;
+typedef _T5 *Indexing_Index;
-typedef _T7 *mcComment_commentDesc;
+typedef _T6 *mcComment_commentDesc;
extern mcComment_commentDesc mcLexBuf_currentcomment;
extern mcComment_commentDesc mcLexBuf_lastcomment;
typedef stringRecord *DynamicStrings_String;
-typedef _T10 *wlists_wlist;
+typedef _T9 *wlists_wlist;
-typedef _T13 *mcPretty_pretty;
+typedef _T12 *mcPretty_pretty;
typedef void (*mcPretty_writeProc_t) (char);
struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; };
-struct _T9_r {
+struct _T8_r {
nameKey_Name name;
void *key;
symbolKey_symbolTree left;
@@ -329,7 +330,7 @@ struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; };
typedef void (*symbolKey_performOperation_t) (void *);
struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; };
-struct _T15_a { void * array[MaxnoOfelements-1+1]; };
+struct _T14_a { void * array[MaxnoOfelements-1+1]; };
typedef void (*Indexing_IndexProcedure_t) (void *);
struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
@@ -368,7 +369,7 @@ typedef libc_exitP_t libc_exitP_C;
struct libc_exitP_p { libc_exitP_t proc; };
-struct _T12_r {
+struct _T11_r {
mcError_error parent;
mcError_error child;
mcError_error next;
@@ -644,7 +645,7 @@ struct cnameT_r {
unsigned int init;
};
-struct _T6_r {
+struct _T5_r {
void *ArrayStart;
unsigned int ArraySize;
unsigned int Used;
@@ -654,18 +655,18 @@ struct _T6_r {
unsigned int Map;
};
-struct _T7_r {
+struct _T6_r {
commentType type;
DynamicStrings_String content;
nameKey_Name procName;
unsigned int used;
};
-struct _T8_a { char array[(MaxBuf-1)+1]; };
-struct _T11_a { unsigned int array[maxNoOfElements-1+1]; };
-struct _T14_r {
+struct _T7_a { char array[(MaxBuf-1)+1]; };
+struct _T10_a { unsigned int array[maxNoOfElements-1+1]; };
+struct _T13_r {
unsigned int noOfelements;
- _T15 elements;
+ _T14 elements;
alists_alist next;
};
@@ -825,13 +826,13 @@ struct impT_r {
commentPair com;
};
-struct _T10_r {
- unsigned int noOfElements;
- _T11 elements;
- wlists_wlist next;
- };
+struct _T9_r {
+ unsigned int noOfElements;
+ _T10 elements;
+ wlists_wlist next;
+ };
-struct _T13_r {
+struct _T12_r {
mcPretty_writeProc write_;
mcPretty_writeLnProc writeln;
unsigned int needsSpace;
@@ -844,7 +845,7 @@ struct _T13_r {
};
struct Contents_r {
- _T8 buf;
+ _T7 buf;
unsigned int len;
DynamicStrings_String next;
};
@@ -873,63 +874,63 @@ struct DebugInfo_r {
void *proc;
};
-struct _T5_r {
- nodeT kind; /* case tag */
- union {
- intrinsicT intrinsicF;
- explistT explistF;
- exitT exitF;
- returnT returnF;
- stmtT stmtF;
- commentT commentF;
- typeT typeF;
- recordT recordF;
- varientT varientF;
- varT varF;
- enumerationT enumerationF;
- subrangeT subrangeF;
- subscriptT subscriptF;
- arrayT arrayF;
- stringT stringF;
- constT constF;
- literalT literalF;
- varparamT varparamF;
- paramT paramF;
- varargsT varargsF;
- optargT optargF;
- pointerT pointerF;
- recordfieldT recordfieldF;
- varientfieldT varientfieldF;
- enumerationfieldT enumerationfieldF;
- setT setF;
- proctypeT proctypeF;
- procedureT procedureF;
- defT defF;
- impT impF;
- moduleT moduleF;
- loopT loopF;
- whileT whileF;
- forT forF;
- repeatT repeatF;
- caseT caseF;
- caselabellistT caselabellistF;
- caselistT caselistF;
- rangeT rangeF;
- ifT ifF;
- elsifT elsifF;
- assignmentT assignmentF;
- arrayrefT arrayrefF;
- pointerrefT pointerrefF;
- componentrefT componentrefF;
- binaryT binaryF;
- unaryT unaryF;
- identlistT identlistF;
- vardeclT vardeclF;
- funccallT funccallF;
- setvalueT setvalueF;
- };
- where at;
- };
+struct nodeRec_r {
+ nodeT kind; /* case tag */
+ union {
+ intrinsicT intrinsicF;
+ explistT explistF;
+ exitT exitF;
+ returnT returnF;
+ stmtT stmtF;
+ commentT commentF;
+ typeT typeF;
+ recordT recordF;
+ varientT varientF;
+ varT varF;
+ enumerationT enumerationF;
+ subrangeT subrangeF;
+ subscriptT subscriptF;
+ arrayT arrayF;
+ stringT stringF;
+ constT constF;
+ literalT literalF;
+ varparamT varparamF;
+ paramT paramF;
+ varargsT varargsF;
+ optargT optargF;
+ pointerT pointerF;
+ recordfieldT recordfieldF;
+ varientfieldT varientfieldF;
+ enumerationfieldT enumerationfieldF;
+ setT setF;
+ proctypeT proctypeF;
+ procedureT procedureF;
+ defT defF;
+ impT impF;
+ moduleT moduleF;
+ loopT loopF;
+ whileT whileF;
+ forT forF;
+ repeatT repeatF;
+ caseT caseF;
+ caselabellistT caselabellistF;
+ caselistT caselistF;
+ rangeT rangeF;
+ ifT ifF;
+ elsifT elsifF;
+ assignmentT assignmentF;
+ arrayrefT arrayrefF;
+ pointerrefT pointerrefF;
+ componentrefT componentrefF;
+ binaryT binaryF;
+ unaryT unaryF;
+ identlistT identlistF;
+ vardeclT vardeclF;
+ funccallT funccallF;
+ setvalueT setvalueF;
+ };
+ where at;
+ };
struct stringRecord_r {
Contents contents;
@@ -2737,6 +2738,8 @@ extern "C" unsigned int mcOptions_getDebugTopological (void);
extern "C" DynamicStrings_String mcOptions_getHPrefix (void);
extern "C" unsigned int mcOptions_getIgnoreFQ (void);
extern "C" unsigned int mcOptions_getGccConfigSystem (void);
+extern "C" unsigned int mcOptions_getScaffoldDynamic (void);
+extern "C" unsigned int mcOptions_getScaffoldMain (void);
extern "C" void mcOptions_writeGPLheader (FIO_File f);
extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
@@ -6174,7 +6177,31 @@ static void populateTodo (nodeProcedure p);
static void topologicallyOut (nodeProcedure c, nodeProcedure t, nodeProcedure v, nodeProcedure tp, nodeProcedure pc, nodeProcedure pt, nodeProcedure pv);
/*
- outImpInitC -
+ scaffoldStatic -
+*/
+
+static void scaffoldStatic (mcPretty_pretty p, decl_node n);
+
+/*
+ emitCtor -
+*/
+
+static void emitCtor (mcPretty_pretty p, decl_node n);
+
+/*
+ scaffoldDynamic -
+*/
+
+static void scaffoldDynamic (mcPretty_pretty p, decl_node n);
+
+/*
+ scaffoldMain -
+*/
+
+static void scaffoldMain (mcPretty_pretty p, decl_node n);
+
+/*
+ outImpInitC - emit the init/fini functions and main function if required.
*/
static void outImpInitC (mcPretty_pretty p, decl_node n);
@@ -6616,8 +6643,11 @@ static decl_node newNode (nodeT k)
{
decl_node d;
- Storage_ALLOCATE ((void **) &d, sizeof (_T5));
- d = static_cast<decl_node> (libc_memset (reinterpret_cast<void *> (d), 0, static_cast<size_t> (sizeof (decl_node))));
+ Storage_ALLOCATE ((void **) &d, sizeof (nodeRec));
+ if (enableMemsetOnAllocation)
+ {
+ d = static_cast<decl_node> (libc_memset (reinterpret_cast<void *> (d), 0, static_cast<size_t> (sizeof ((*d)))));
+ }
if (d == NULL)
{
M2RTS_HALT (-1);
@@ -6642,7 +6672,7 @@ static decl_node newNode (nodeT k)
static void disposeNode (decl_node *n)
{
- Storage_DEALLOCATE ((void **) &(*n), sizeof (_T5));
+ Storage_DEALLOCATE ((void **) &(*n), sizeof (nodeRec));
(*n) = NULL;
}
@@ -20010,10 +20040,10 @@ static void topologicallyOut (nodeProcedure c, nodeProcedure t, nodeProcedure v,
/*
- outImpInitC -
+ scaffoldStatic -
*/
-static void outImpInitC (mcPretty_pretty p, decl_node n)
+static void scaffoldStatic (mcPretty_pretty p, decl_node n)
{
outText (p, (const char *) "\\n", 2);
doExternCP (p);
@@ -20042,6 +20072,139 @@ static void outImpInitC (mcPretty_pretty p, decl_node n)
}
+/*
+ emitCtor -
+*/
+
+static void emitCtor (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ outText (p, (const char *) "\\n", 2);
+ outText (p, (const char *) "static void", 11);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "ctorFunction ()\\n", 17);
+ doFQNameC (p, n);
+ p = outKc (p, (const char *) "{\\n", 3);
+ outText (p, (const char *) "M2RTS_RegisterModule (\"", 23);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ mcPretty_prints (p, s);
+ outText (p, (const char *) "\",\\n", 4);
+ outText (p, (const char *) "init, fini, dependencies);\\n", 28);
+ p = outKc (p, (const char *) "}\\n\\n", 5);
+ p = outKc (p, (const char *) "struct ", 7);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 { ", 13);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 (); ~", 16);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 (); } global_module_", 31);
+ mcPretty_prints (p, s);
+ outText (p, (const char *) ";\\n\\n", 5);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2::", 12);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 ()\\n", 15);
+ p = outKc (p, (const char *) "{\\n", 3);
+ outText (p, (const char *) "M2RTS_RegisterModule (\"", 23);
+ mcPretty_prints (p, s);
+ outText (p, (const char *) "\", init, fini, dependencies);", 29);
+ p = outKc (p, (const char *) "}\\n", 3);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2::~", 13);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 ()\\n", 15);
+ p = outKc (p, (const char *) "{\\n", 3);
+ p = outKc (p, (const char *) "}\\n", 3);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ scaffoldDynamic -
+*/
+
+static void scaffoldDynamic (mcPretty_pretty p, decl_node n)
+{
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_init", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc,", 34);
+ outText (p, (const char *) " __attribute__((unused)) char *argv[],", 38);
+ outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->impF.beginStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_fini", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc,", 34);
+ outText (p, (const char *) " __attribute__((unused)) char *argv[],", 38);
+ outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->impF.finallyStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+ emitCtor (p, n);
+}
+
+
+/*
+ scaffoldMain -
+*/
+
+static void scaffoldMain (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ outText (p, (const char *) "int\\n", 5);
+ outText (p, (const char *) "main", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(int argc, char *argv[], char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ outText (p, (const char *) "M2RTS_ConstructModules (", 24);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ mcPretty_prints (p, s);
+ outText (p, (const char *) ", argc, argv, envp);\\n", 22);
+ outText (p, (const char *) "M2RTS_DeconstructModules (", 26);
+ mcPretty_prints (p, s);
+ outText (p, (const char *) ", argc, argv, envp);\\n", 22);
+ outText (p, (const char *) "return 0;", 9);
+ p = outKc (p, (const char *) "}\\n", 3);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ outImpInitC - emit the init/fini functions and main function if required.
+*/
+
+static void outImpInitC (mcPretty_pretty p, decl_node n)
+{
+ if (mcOptions_getScaffoldDynamic ())
+ {
+ scaffoldDynamic (p, n);
+ }
+ else
+ {
+ scaffoldStatic (p, n);
+ }
+ if (mcOptions_getScaffoldMain ())
+ {
+ scaffoldMain (p, n);
+ }
+}
+
+
/*
runSimplifyTypes -
*/
diff --git a/gcc/m2/mc-boot/GmcOptions.c b/gcc/m2/mc-boot/GmcOptions.c
index 9f00acf1bbe..9cda6357a63 100644
--- a/gcc/m2/mc-boot/GmcOptions.c
+++ b/gcc/m2/mc-boot/GmcOptions.c
@@ -58,6 +58,8 @@ static unsigned int gplHeader;
static unsigned int glplHeader;
static unsigned int summary;
static unsigned int contributed;
+static unsigned int scaffoldMain;
+static unsigned int scaffoldDynamic;
static unsigned int caseRuntime;
static unsigned int arrayRuntime;
static unsigned int returnRuntime;
@@ -151,6 +153,18 @@ extern "C" unsigned int mcOptions_getIgnoreFQ (void);
extern "C" unsigned int mcOptions_getGccConfigSystem (void);
+/*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldDynamic (void);
+
+/*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldMain (void);
+
/*
writeGPLheader - writes out the GPL or the LGPL as a comment.
*/
@@ -332,6 +346,8 @@ static void displayHelp (void)
mcPrintf_printf0 ((const char *) " --contributed=\"foo\" generate a one line contribution comment near the top of the file\\n", 89);
mcPrintf_printf0 ((const char *) " --project=\"foo\" include the project name within the GPL3 or GLPL3 header\\n", 80);
mcPrintf_printf0 ((const char *) " --automatic generate a comment at the start of the file warning not to edit as it was automatically generated\\n", 121);
+ mcPrintf_printf0 ((const char *) " --scaffold-dynamic generate dynamic module initialization code for C++\\n", 75);
+ mcPrintf_printf0 ((const char *) " --scaffold-main generate main function which calls upon the dynamic initialization support in M2RTS\\n", 107);
mcPrintf_printf0 ((const char *) " filename the source file must be the last option\\n", 63);
libc_exit (0);
}
@@ -764,6 +780,16 @@ static void handleOption (DynamicStrings_String arg)
/* avoid dangling else. */
gccConfigSystem = TRUE;
}
+ else if (optionIs ((const char *) "--scaffold-main", 15, arg))
+ {
+ /* avoid dangling else. */
+ scaffoldMain = TRUE;
+ }
+ else if (optionIs ((const char *) "--scaffold-dynamic", 18, arg))
+ {
+ /* avoid dangling else. */
+ scaffoldDynamic = TRUE;
+ }
}
@@ -952,6 +978,30 @@ extern "C" unsigned int mcOptions_getGccConfigSystem (void)
}
+/*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldDynamic (void)
+{
+ return scaffoldDynamic;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldMain (void)
+{
+ return scaffoldMain;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
/*
writeGPLheader - writes out the GPL or the LGPL as a comment.
*/
@@ -980,6 +1030,8 @@ extern "C" void _M2_mcOptions_init (__attribute__((unused)) int argc, __attribut
debugTopological = FALSE;
ignoreFQ = FALSE;
gccConfigSystem = FALSE;
+ scaffoldMain = FALSE;
+ scaffoldDynamic = FALSE;
hPrefix = DynamicStrings_InitString ((const char *) "", 0);
cppArgs = DynamicStrings_InitString ((const char *) "", 0);
cppProgram = DynamicStrings_InitString ((const char *) "", 0);
diff --git a/gcc/m2/mc-boot/GmcOptions.h b/gcc/m2/mc-boot/GmcOptions.h
index 6952aa4e94e..d1c653720cf 100644
--- a/gcc/m2/mc-boot/GmcOptions.h
+++ b/gcc/m2/mc-boot/GmcOptions.h
@@ -115,6 +115,18 @@ EXTERN unsigned int mcOptions_getIgnoreFQ (void);
EXTERN unsigned int mcOptions_getGccConfigSystem (void);
+/*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*/
+
+EXTERN unsigned int mcOptions_getScaffoldDynamic (void);
+
+/*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*/
+
+EXTERN unsigned int mcOptions_getScaffoldMain (void);
+
/*
writeGPLheader - writes out the GPL or the GLPL as a comment.
*/
diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod
index 4e54155b362..26fa06249c2 100644
--- a/gcc/m2/mc/decl.mod
+++ b/gcc/m2/mc/decl.mod
@@ -30,7 +30,7 @@ FROM SFIO IMPORT OpenToWrite, WriteS ;
FROM FIO IMPORT File, Close, FlushBuffer, StdOut, WriteLine, WriteChar ;
FROM DynamicStrings IMPORT String, InitString, EqualArray, InitStringCharStar, KillString, ConCat, Mark, RemoveWhitePostfix, RemoveWhitePrefix ;
FROM StringConvert IMPORT CardinalToString, ostoc ;
-FROM mcOptions IMPORT getOutputFile, getDebugTopological, getHPrefix, getIgnoreFQ, getExtendedOpaque, writeGPLheader, getGccConfigSystem ;
+FROM mcOptions IMPORT getOutputFile, getDebugTopological, getHPrefix, getIgnoreFQ, getExtendedOpaque, writeGPLheader, getGccConfigSystem, getScaffoldDynamic, getScaffoldMain ;
FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
FROM libc IMPORT printf, memset ;
FROM mcMetaError IMPORT metaError1, metaError2, metaError3, metaErrors1, metaErrors2 ;
@@ -73,7 +73,7 @@ CONST
(* 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. *)
-
+ enableMemsetOnAllocation = TRUE ; (* Should we memset (..., 0, ...) the allocated mem? *)
TYPE
language = (ansiC, ansiCP, pim4) ;
@@ -122,7 +122,9 @@ TYPE
lsl, lsr, lor, land, lnot, lxor,
and, or, not, identlist, vardecl, setvalue) ;
- node = POINTER TO RECORD
+ node = POINTER TO nodeRec ;
+
+ nodeRec = RECORD
CASE kind: nodeT OF
unreachable,
@@ -760,7 +762,10 @@ VAR
d: node ;
BEGIN
NEW (d) ;
- d := memset (d, 0, SIZE (node)) ;
+ IF enableMemsetOnAllocation
+ THEN
+ d := memset (d, 0, SIZE (d^))
+ END ;
IF d=NIL
THEN
HALT
@@ -14049,10 +14054,10 @@ END topologicallyOut ;
(*
- outImpInitC -
+ scaffoldStatic -
*)
-PROCEDURE outImpInitC (p: pretty; n: node) ;
+PROCEDURE scaffoldStatic (p: pretty; n: node) ;
BEGIN
outText (p, "\n") ;
doExternCP (p) ;
@@ -14078,6 +14083,137 @@ BEGIN
p := outKc (p, "{\n") ;
doStatementsC (p, n^.impF.finallyStatements) ;
p := outKc (p, "}\n")
+END scaffoldStatic ;
+
+
+(*
+ emitCtor -
+*)
+
+PROCEDURE emitCtor (p: pretty; n: node) ;
+VAR
+ s: String ;
+BEGIN
+ outText (p, "\n") ;
+ outText (p, "static void") ;
+ setNeedSpace (p) ;
+ outText (p, "ctorFunction ()\n") ;
+ doFQNameC (p, n) ;
+ p := outKc (p, "{\n") ;
+ outText (p, 'M2RTS_RegisterModule ("') ;
+ s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+ prints (p, s) ;
+ outText (p, '",\n') ;
+ outText (p, 'init, fini, dependencies);\n') ;
+ p := outKc (p, "}\n\n") ;
+ p := outKc (p, "struct ") ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2 { ") ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2 (); ~") ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2 (); } global_module_") ;
+ prints (p, s) ;
+ outText (p, ';\n\n') ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2::") ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2 ()\n") ;
+ p := outKc (p, "{\n") ;
+ outText (p, 'M2RTS_RegisterModule ("') ;
+ prints (p, s) ;
+ outText (p, '", init, fini, dependencies);') ;
+ p := outKc (p, "}\n") ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2::~") ;
+ prints (p, s) ;
+ p := outKc (p, "_module_m2 ()\n") ;
+ p := outKc (p, "{\n") ;
+ p := outKc (p, "}\n") ;
+ s := KillString (s)
+END emitCtor ;
+
+
+(*
+ scaffoldDynamic -
+*)
+
+PROCEDURE scaffoldDynamic (p: pretty; n: node) ;
+BEGIN
+ outText (p, "\n") ;
+ doExternCP (p) ;
+ outText (p, "void") ;
+ setNeedSpace (p) ;
+ outText (p, "_M2_") ;
+ doFQNameC (p, n) ;
+ outText (p, "_init") ;
+ setNeedSpace (p) ;
+ outText (p, "(__attribute__((unused)) int argc,") ;
+ outText (p, " __attribute__((unused)) char *argv[],") ;
+ outText (p, " __attribute__((unused)) char *envp[])\n") ;
+ p := outKc (p, "{\n") ;
+ doStatementsC (p, n^.impF.beginStatements) ;
+ p := outKc (p, "}\n") ;
+ outText (p, "\n") ;
+ doExternCP (p) ;
+ outText (p, "void") ;
+ setNeedSpace (p) ;
+ outText (p, "_M2_") ;
+ doFQNameC (p, n) ;
+ outText (p, "_fini") ;
+ setNeedSpace (p) ;
+ outText (p, "(__attribute__((unused)) int argc,") ;
+ outText (p, " __attribute__((unused)) char *argv[],") ;
+ outText (p, " __attribute__((unused)) char *envp[])\n") ;
+ p := outKc (p, "{\n") ;
+ doStatementsC (p, n^.impF.finallyStatements) ;
+ p := outKc (p, "}\n") ;
+ emitCtor (p, n)
+END scaffoldDynamic ;
+
+
+(*
+ scaffoldMain -
+*)
+
+PROCEDURE scaffoldMain (p: pretty; n: node) ;
+VAR
+ s: String ;
+BEGIN
+ outText (p, "int\n") ;
+ outText (p, "main") ;
+ setNeedSpace (p) ;
+ outText (p, "(int argc, char *argv[], char *envp[])\n") ;
+ p := outKc (p, "{\n") ;
+ outText (p, "M2RTS_ConstructModules (") ;
+ s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+ prints (p, s) ;
+ outText (p, ", argc, argv, envp);\n");
+ outText (p, "M2RTS_DeconstructModules (") ;
+ prints (p, s) ;
+ outText (p, ", argc, argv, envp);\n");
+ outText (p, "return 0;") ;
+ p := outKc (p, "}\n") ;
+ s := KillString (s)
+END scaffoldMain ;
+
+
+(*
+ outImpInitC - emit the init/fini functions and main function if required.
+*)
+
+PROCEDURE outImpInitC (p: pretty; n: node) ;
+BEGIN
+ IF getScaffoldDynamic ()
+ THEN
+ scaffoldDynamic (p, n)
+ ELSE
+ scaffoldStatic (p, n)
+ END ;
+ IF getScaffoldMain ()
+ THEN
+ scaffoldMain (p, n)
+ END
END outImpInitC ;
diff --git a/gcc/m2/mc/mcOptions.def b/gcc/m2/mc/mcOptions.def
index a7d91d3e81c..a26865a8985 100644
--- a/gcc/m2/mc/mcOptions.def
+++ b/gcc/m2/mc/mcOptions.def
@@ -113,6 +113,20 @@ PROCEDURE getIgnoreFQ () : BOOLEAN ;
PROCEDURE getGccConfigSystem () : BOOLEAN ;
+(*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*)
+
+PROCEDURE getScaffoldDynamic () : BOOLEAN ;
+
+
+(*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*)
+
+PROCEDURE getScaffoldMain () : BOOLEAN ;
+
+
(*
writeGPLheader - writes out the GPL or the GLPL as a comment.
*)
diff --git a/gcc/m2/mc/mcOptions.mod b/gcc/m2/mc/mcOptions.mod
index 6eb13e36162..acd80a2c0e9 100644
--- a/gcc/m2/mc/mcOptions.mod
+++ b/gcc/m2/mc/mcOptions.mod
@@ -44,6 +44,8 @@ VAR
glplHeader,
summary,
contributed,
+ scaffoldMain,
+ scaffoldDynamic,
caseRuntime,
arrayRuntime,
returnRuntime,
@@ -117,6 +119,8 @@ BEGIN
printf0 (' --contributed="foo" generate a one line contribution comment near the top of the file\n') ;
printf0 (' --project="foo" include the project name within the GPL3 or GLPL3 header\n') ;
printf0 (' --automatic generate a comment at the start of the file warning not to edit as it was automatically generated\n') ;
+ printf0 (' --scaffold-dynamic generate dynamic module initialization code for C++\n') ;
+ printf0 (' --scaffold-main generate main function which calls upon the dynamic initialization support in M2RTS\n') ;
printf0 (" filename the source file must be the last option\n") ;
exit (0)
END displayHelp ;
@@ -511,6 +515,26 @@ BEGIN
END getGccConfigSystem ;
+(*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*)
+
+PROCEDURE getScaffoldDynamic () : BOOLEAN ;
+BEGIN
+ RETURN scaffoldDynamic
+END getScaffoldDynamic ;
+
+
+(*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*)
+
+PROCEDURE getScaffoldMain () : BOOLEAN ;
+BEGIN
+ RETURN scaffoldMain
+END getScaffoldMain ;
+
+
(*
optionIs - returns TRUE if the first len (right) characters
match left.
@@ -620,6 +644,12 @@ BEGIN
ELSIF optionIs ('--gcc-config-system', arg)
THEN
gccConfigSystem := TRUE
+ ELSIF optionIs ('--scaffold-main', arg)
+ THEN
+ scaffoldMain := TRUE
+ ELSIF optionIs ('--scaffold-dynamic', arg)
+ THEN
+ scaffoldDynamic := TRUE
END
END handleOption ;
@@ -676,6 +706,8 @@ BEGIN
debugTopological := FALSE ;
ignoreFQ := FALSE ;
gccConfigSystem := FALSE ;
+ scaffoldMain := FALSE ;
+ scaffoldDynamic := FALSE ;
hPrefix := InitString ('') ;
cppArgs := InitString ('') ;
cppProgram := InitString ('') ;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-09-06 23:06 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-09-06 23:06 [gcc/devel/modula-2] Bugfix mc memset correction, correct comments and add options to mc 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).