Generated code for FOR-loops was wrong

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index c8107c2..c04c56c 100644 (file)
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -123,7 +123,7 @@ GetString(upto)
                }
                *p++ = ch;
                if (p - str->s_str == len)      {
-                       str->s_str = Srealloc(str->s_str,
+                       str->s_str = Realloc(str->s_str,
                                (unsigned int) len + RSTRSIZE);
                        p = str->s_str + len;
                        len += RSTRSIZE;

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 5a06852..a26b297 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -1001,6 +1001,7 @@ CodeDAddress(nd)
 
        register struct desig *designator = new_desig();
 
+       ChkForFOR(nd);
        CodeDesig(nd, designator);
        CodeAddress(designator);
        free_desig(designator);
@@ -1015,6 +1016,7 @@ CodeDStore(nd)
 
        register struct desig *designator = new_desig();
 
+       ChkForFOR(nd);
        CodeDesig(nd, designator);
        CodeStore(designator, nd->nd_type);
        free_desig(designator);

diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index 5cd7a6a..0635fd0 100644 (file)
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -113,6 +113,7 @@ struct def  {               /* list of definitions for a name */
 #define D_BUSY         0x80    /* set if busy reading this definition module */
 #define D_FOREIGN      0x100   /* set for foreign language modules */
 #define D_ADDRGIVEN    0x200   /* set if address given for variable */
+#define D_FORLOOP      0x400   /* set if busy in for-loop */
        struct type *df_type;
        union {
                struct module df_module;

diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index ff88c66..8c8f695 100644 (file)
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -30,6 +30,7 @@
 #include       "scope.h"
 #include       "desig.h"
 #include       "node.h"
+#include       "warning.h"
 
 extern int     proclevel;
 
@@ -165,6 +166,21 @@ CodeValue(ds, tp)
        ds->dsg_kind = DSG_LOADED;
 }
 
+ChkForFOR(nd)
+       struct node *nd;
+{
+       if (nd->nd_class == Def) {
+               register struct def *df = nd->nd_def;
+
+               if (df->df_flags & D_FORLOOP) {
+                       node_warning(nd,
+                                    W_ORDINARY,
+                                    "assignment to FOR-loop control variable");
+                       df->df_flags &= ~D_FORLOOP;
+               }
+       }
+}
+
 CodeStore(ds, tp)
        register struct desig *ds;
        register struct type *tp;
@@ -175,6 +191,7 @@ CodeStore(ds, tp)
        struct desig save;
 
        save = *ds;
+
        switch(ds->dsg_kind) {
        case DSG_FIXED:
                if (DoStore(ds, tp->tp_size)) break;
@@ -233,6 +250,7 @@ CodeMove(rhs, left, rtp)
                generated.
        */
 
+       ChkForFOR(left);
        switch(rhs->dsg_kind) {
        case DSG_LOADED:
                CodeDesig(left, lhs);

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 312eb9c..d378865 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -482,42 +482,66 @@ WalkStat(nd, exit_label)
                        label l1 = ++text_label;
                        label l2 = ++text_label;
                        int uns = 0;
+                       arith stepsize;
 
-                       good_forvar = DoForInit(nd, left);
+                       good_forvar = DoForInit(nd);
+                       if ((stepsize = left->nd_INT) == 0) {
+                           node_warning(left,
+                                        W_ORDINARY,
+                                        "zero stepsize in FOR loop");
+                       }
+                       if (stepsize < 0) {
+                               stepsize = -stepsize;
+                       }
                        fnd = left->nd_right;
                        if (good_forvar) {
-                               uns = BaseType(nd->nd_type)->tp_fund != T_INTEGER;
-                               if (fnd->nd_class != Value) {
-                                       /* Upperbound not constant.
-                                          The expression may only be evaluated
-                                          once, so generate a temporary for it
-                                       */
-                                       CodePExpr(fnd);
-                                       tmp = NewInt();
-                                       C_stl(tmp);
-                               }
-                               C_df_ilb(l1);
+                               uns = BaseType(nd->nd_type)->tp_fund !=
+                                               T_INTEGER;
                                C_dup(int_size);
-                               if (tmp) C_lol(tmp); else C_loc(fnd->nd_INT);
+                               CodePExpr(fnd);
+                               tmp = NewInt();
+                               C_stl(tmp);
+                               C_lol(tmp);
                                if (uns) C_cmu(int_size);
                                else C_cmi(int_size);
-                               if (left->nd_INT > 0) {
+                               if (left->nd_INT >= 0) {
                                        C_zgt(l2);
+                                       CodeDStore(nd);
+                                       C_lol(tmp);
+                                       CodePExpr(nd);
                                }
-                               else    C_zlt(l2);
-                               CodeDStore(nd);
+                               else {
+                                       C_zlt(l2);
+                                       CodeDStore(nd);
+                                       CodePExpr(nd);
+                                       C_lol(tmp);
+                               }
+                               C_sbu(int_size);
+                               if (stepsize) {
+                                       C_loc(stepsize);
+                                       C_dvu(int_size);
+                                       C_loc((arith) 1);
+                                       C_adu(int_size);
+                               }
+                               nd->nd_def->df_flags |= D_FORLOOP;
+                               C_df_ilb(l1);
                        }
                        WalkNode(right, exit_label);
-                       if (good_forvar) {      
-                               CodePExpr(nd);
+                       nd->nd_def->df_flags &= ~D_FORLOOP;
+                       if (stepsize && good_forvar) {  
+                               C_loc((arith) 1);
+                               C_sbu(int_size);
+                               C_dup(int_size);
+                               C_zeq(l2);
                                C_loc(left->nd_INT);
-                               if (uns) C_adu(int_size);
-                               else C_adi(int_size);
-                               C_bra(l1);
-                               C_df_ilb(l2);
-                               C_asp(int_size);
+                               CodePExpr(nd);
+                               C_adu(int_size);
+                               CodeDStore(nd);
                        }
-                       if (tmp) FreeInt(tmp);
+                       C_bra(l1);
+                       C_df_ilb(l2);
+                       C_asp(int_size);
+                       FreeInt(tmp);
 #ifdef DEBUG
                        nd->nd_left = left;
                        nd->nd_right = right;
@@ -642,9 +666,10 @@ WalkDesignator(nd, ds)
        return 1;
 }
 
-DoForInit(nd, left)
-       register struct node *nd, *left;
+DoForInit(nd)
+       register struct node *nd;
 {
+       register struct node *left = nd->nd_left;
        register struct def *df;
        struct type *tpl, *tpr;