some fixes, and changed priority of unary minus
authorceriel <none@none>
Thu, 18 Jun 1987 15:46:08 +0000 (15:46 +0000)
committerceriel <none@none>
Thu, 18 Jun 1987 15:46:08 +0000 (15:46 +0000)
13 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/Makefile
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/cstoper.c
lang/m2/comp/declar.g
lang/m2/comp/def.H
lang/m2/comp/defmodule.c
lang/m2/comp/expression.g
lang/m2/comp/program.g
lang/m2/comp/type.H
lang/m2/comp/type.c
lang/m2/comp/walk.c

index 95098c9..eced010 100644 (file)
@@ -24,6 +24,7 @@
 #include       "Lpars.h"
 #include       "class.h"
 #include       "idf.h"
+#include       "def.h"
 #include       "type.h"
 #include       "LLlex.h"
 #include       "const.h"
@@ -62,7 +63,7 @@ SkipComment()
                           of the names. Also, don't generate call to
                           initialization routine.
                        */
-                       ForeignFlag = 1;
+                       ForeignFlag = D_FOREIGN;
                        break;
                }
        }
@@ -231,8 +232,6 @@ LLlex()
                return tk->tk_symb;
        }
 
-       tk->tk_lineno = LineNumber;
-
 again1:
        if (eofseen) {
                eofseen = 0;
@@ -247,6 +246,8 @@ again:
                }
        }
 
+       tk->tk_lineno = LineNumber;
+
        switch (class(ch))      {
 
        case STNL:
@@ -254,7 +255,6 @@ again:
 #ifdef DEBUG
                cntlines++;
 #endif
-               tk->tk_lineno++;
                CheckForLineDirective();
                goto again1;
 
index fb1d9ee..ab5dc37 100644 (file)
@@ -158,6 +158,7 @@ LLlex.o: class.h
 LLlex.o: const.h
 LLlex.o: debug.h
 LLlex.o: debugcst.h
+LLlex.o: def.h
 LLlex.o: f_info.h
 LLlex.o: idf.h
 LLlex.o: idfsize.h
index 9da7a71..6c8a7c9 100644 (file)
@@ -758,6 +758,10 @@ ChkBinOper(expp)
           - The IN-operator has as right-hand-size operand a set.
        */
        if (expp->nd_symb == IN) {
+               if (tpr->tp_fund != T_SET) {
+                       node_error(expp, "\"IN\": right operand must be a set");
+                       return 0;
+               }
                if (!TstAssCompat(tpl, ElementType(tpr))) {
                        /* Assignment compatible ???
                           I don't know! Should we be allowed to check
@@ -831,12 +835,13 @@ ChkUnOper(expp)
 
        switch(expp->nd_symb) {
        case '+':
-               if (tpr->tp_fund & T_NUMERIC) {
-                       *expp = *right;
-                       free_node(right);
-                       return 1;
-               }
-               break;
+               if (!(tpr->tp_fund & T_NUMERIC)) break;
+               /* fall through */
+
+       case '(':
+               *expp = *right;
+               free_node(right);
+               return 1;
 
        case '-':
                if (tpr->tp_fund & T_INTORCARD) {
index ed6062b..a620468 100644 (file)
@@ -396,8 +396,14 @@ CodeParameters(param, arg)
                return;
        }
        CodePExpr(left);
-       RangeCheck(tp, left_type);
-       CodeCoercion(left_type, tp);
+       CodeCheckExpr(left, tp);
+}
+
+CodeCheckExpr(tp1, tp2)
+       struct type *tp1, *tp2;
+{
+       CodeCoercion(tp1, tp2);
+       RangeCheck(tp2, tp1);
 }
 
 CodePString(nd, tp)
@@ -749,6 +755,7 @@ CodeOper(expr, true_label, false_label)
                                C_dup(2*tp->tp_size);
                                C_asp(tp->tp_size);
                                C_ior(tp->tp_size);
+                               expr->nd_symb = '=';
                        }
                        else if (expr->nd_symb == LESSEQUAL) {
                                /* A <= B is the same as A - B = {}
@@ -756,6 +763,7 @@ CodeOper(expr, true_label, false_label)
                                C_com(tp->tp_size);
                                C_and(tp->tp_size);
                                C_zer(tp->tp_size);
+                               expr->nd_symb = '=';
                        }
                        C_cms(tp->tp_size);
                        break;
index a2f182f..22b453b 100644 (file)
@@ -262,6 +262,7 @@ cstset(expp)
                expp->nd_INT = (i >= 0 && i < setsize * wrd_bits &&
                    (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
                free((char *) set2);
+               expp->nd_symb = INTEGER;
        }
        else {
                set1 = expp->nd_left->nd_set;
index 3a67f1a..ff256dc 100644 (file)
@@ -169,7 +169,7 @@ SimpleType(register struct type **ptp;)
                /* The subrange type is given a base type by the
                   qualident (this is new modula-2).
                */
-                       { chk_basesubrange(tp, *ptp); }
+                       { chk_basesubrange(tp, *ptp); *ptp = tp; }
        ]
 |
        enumeration(ptp)
index e50947d..15111f4 100644 (file)
@@ -33,7 +33,7 @@ struct constant {
 };
 
 struct enumval {
-       unsigned int en_val;    /* value of this enumeration literal */
+       arith en_val;   /* value of this enumeration literal */
        struct def *en_next;    /* next enumeration literal */
 #define enm_val                df_value.df_enum.en_val
 #define enm_next       df_value.df_enum.en_next
index 0bbe2e0..35815a1 100644 (file)
@@ -92,6 +92,8 @@ GetDefinitionModule(id, incr)
        register struct def *df;
        static int level;
        struct scopelist *vis;
+       char *fn = FileName;
+       int ln = LineNumber;
 
        level += incr;
        df = lookup(id, GlobalScope, 1);
@@ -109,6 +111,7 @@ GetDefinitionModule(id, incr)
                        ForeignFlag = 0;
                        open_scope(CLOSEDSCOPE);
                        if (!is_anon_idf(id) && GetFile(id->id_text)) {
+
                                DefModule();
                                df = lookup(id, GlobalScope, 1);
                                if (level == 1 &&
@@ -152,6 +155,8 @@ GetDefinitionModule(id, incr)
                error("cannot import from currently defined module");
                df->df_kind = D_ERROR;
        }
+       FileName = fn;
+       LineNumber = ln;
        assert(df);
        level -= incr;
        return df;
index 92cc725..7a89fde 100644 (file)
@@ -29,6 +29,7 @@
 extern char    options[];
 }
 
+/* inline, we need room for pdp/11
 number(struct node **p;) :
 [
        %default
@@ -39,6 +40,7 @@ number(struct node **p;) :
                          (*p)->nd_type = toktype;
                        }
 ;
+*/
 
 qualident(struct node **p;)
 {
@@ -112,21 +114,28 @@ relation:
 
 SimpleExpression(struct node **pnd;)
 {
+       register struct node *nd = 0;
 } :
        [
                [ '+' | '-' ]
-                       { *pnd = MkLeaf(Uoper, &dot);
-                         pnd = &((*pnd)->nd_right);
+                       { nd = MkLeaf(Uoper, &dot);
                          /* priority of unary operator ??? */
                        }
        ]?
        term(pnd)
+                       { if (nd) {
+                               nd->nd_right = *pnd;
+                               *pnd = nd;
+                         }
+                         nd = *pnd;
+                       }
        [
                /* AddOperator */
                [ '+' | '-' | OR ]
-                       { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
-               term(&((*pnd)->nd_right))
+                       { nd = MkNode(Oper, nd, NULLNODE, &dot); }
+               term(&(nd->nd_right))
        ]*
+                       { *pnd = nd; }
 ;
 
 /* Inline in "SimpleExpression"
@@ -171,13 +180,35 @@ factor(register struct node **p;)
 |
        bare_set(p)
 | %default
-       number(p)
+       [
+               %default
+               INTEGER
+       |
+               REAL
+       |
+               STRING
+       ]               { *p = MkLeaf(Value, &dot);
+                         (*p)->nd_type = toktype;
+                       }
 |
-       STRING  { *p = MkLeaf(Value, &dot);
-                 (*p)->nd_type = toktype;
+       '('     { nd = MkLeaf(Uoper, &dot); }
+       expression(p)
+               { /*    In some cases we must leave the '(' as an unary
+                       operator, because otherwise we cannot see that the
+                       factor was not a designator
+                 */
+                 register int class = (*p)->nd_class;
+
+                 if (class == Arrsel ||
+                     class == Arrow ||
+                     class == Name ||
+                     class == Link) {
+                       nd->nd_right = *p;
+                       *p = nd;
+                 }
+                 else free_node(nd);
                }
-|
-       '(' expression(p) ')'
+       ')'
 |
        NOT             { *p = MkLeaf(Uoper, &dot); }
        factor(&((*p)->nd_right))
@@ -204,7 +235,7 @@ ActualParameters(struct node **pnd;):
        '(' ExpList(pnd)? ')'
 ;
 
-element(struct node *nd;)
+element(register struct node *nd;)
 {
        struct node *nd1;
 } :
@@ -235,17 +266,23 @@ designator_tail(struct node **pnd;):
        ]*
 ;
 
-visible_designator_tail(register struct node **pnd;):
-       '['             { *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot); }
-               expression(&((*pnd)->nd_right))
+visible_designator_tail(struct node **pnd;)
+{
+       register struct node *nd = *pnd;
+}:
+[
+       '['             { nd = MkNode(Arrsel, nd, NULLNODE, &dot); }
+               expression(&(nd->nd_right))
                [
                        ','
-                       { *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot);
-                         (*pnd)->nd_symb = '[';
+                       { nd = MkNode(Arrsel, nd, NULLNODE, &dot);
+                         nd->nd_symb = '[';
                        }
-                       expression(&((*pnd)->nd_right))
+                       expression(&(nd->nd_right))
                ]*
        ']'
 |
-       '^'             { *pnd = MkNode(Arrow, NULLNODE, *pnd, &dot); }
+       '^'             { nd = MkNode(Arrow, NULLNODE, nd, &dot); }
+]
+                       { *pnd = nd; }
 ;
index e685240..5588ae6 100644 (file)
@@ -129,7 +129,7 @@ DefinitionModule
        DEFINITION
        MODULE IDENT    { df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
                          df->df_flags |= D_BUSY;
-                         if (ForeignFlag) df->df_flags |= D_FOREIGN;
+                         df->df_flags |= ForeignFlag;
                          if (!Defined) Defined = df;
                          CurrentScope->sc_definedby = df;
                          if (df->df_idf != DefId) {
index da40e3b..028a0e4 100644 (file)
@@ -20,7 +20,7 @@ struct paramlist {            /* structure for parameterlist of a PROCEDURE */
 
 struct enume {
        struct def *en_enums;   /* Definitions of enumeration literals */
-       unsigned int en_ncst;   /* Number of constants */
+       arith en_ncst;          /* Number of constants */
        label en_rck;           /* Label of range check descriptor */
 #define enm_enums      tp_value.tp_enum.en_enums
 #define enm_ncst       tp_value.tp_enum.en_ncst
index 431218c..3f6bd0e 100644 (file)
@@ -231,6 +231,9 @@ enum_type(EnumList)
                standard_type(T_ENUMERATION, int_align, int_size);
 
        EnterEnumList(EnumList, tp);
+       if (! fit(tp->enm_ncst, (int) int_size)) {
+               node_error(EnumList, "too many enumeration literals");
+       }
        u_small(tp, (arith) (tp->enm_ncst-1));
        return tp;
 }
index ad0bae8..d186f27 100644 (file)
@@ -760,8 +760,7 @@ DoAssign(nd, left, right)
        }
        else {
                CodeValue(&dsr, rtp->tp_size, rtp->tp_align);
-               CodeCoercion(rtp, ltp);
-               RangeCheck(ltp, rtp);
+               CodeCheckExpr(rtp, ltp);
        }
        CodeMove(&dsr, left, rtp);
 }