newer version
authorceriel <none@none>
Thu, 17 Apr 1986 09:28:09 +0000 (09:28 +0000)
committerceriel <none@none>
Thu, 17 Apr 1986 09:28:09 +0000 (09:28 +0000)
18 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/LLlex.h
lang/m2/comp/Makefile
lang/m2/comp/Parameters [new file with mode: 0644]
lang/m2/comp/chk_expr.c
lang/m2/comp/cstoper.c
lang/m2/comp/declar.g
lang/m2/comp/def.H
lang/m2/comp/error.c
lang/m2/comp/input.h
lang/m2/comp/main.c
lang/m2/comp/make.hfiles [new file with mode: 0755]
lang/m2/comp/options.c [new file with mode: 0644]
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/statement.g
lang/m2/comp/type.H
lang/m2/comp/type.c

index db080a5..c53e315 100644 (file)
@@ -6,6 +6,11 @@ static char *RcsId = "$Header$";
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
+
+#include       "idfsize.h"
+#include       "numsize.h"
+#include       "strsize.h"
+
 #include       "input.h"
 #include       "f_info.h"
 #include       "Lpars.h"
@@ -15,14 +20,12 @@ static char *RcsId = "$Header$";
 #include       "LLlex.h"
 #include       "const.h"
 
-#define IDFSIZE        256     /* Number of significant characters in an identifier */
-#define NUMSIZE        256     /* maximum number of characters in a number */
-
 long str2long();
 
 struct token dot, aside;
 struct type *numtype;
 struct string string;
+int idfsize = IDFSIZE;
 
 static
 SkipComment()
@@ -73,7 +76,7 @@ GetString(upto)
        register struct string *str = &string;
        register char *p;
        
-       str->s_str = p = Malloc(str->s_length = 32);
+       str->s_str = p = Malloc((unsigned) (str->s_length = ISTRSIZE));
        LoadChar(ch);
        while (ch != upto)      {
                if (class(ch) == STNL)  {
@@ -87,8 +90,10 @@ GetString(upto)
                }
                *p++ = ch;
                if (p - str->s_str == str->s_length)    {
-                       str->s_str = Srealloc(str->s_str, str->s_length += 8);
-                       p = str->s_str + (str->s_length - 8);
+                       str->s_str = Srealloc(str->s_str,
+                                             str->s_length + RSTRSIZE);
+                       p = str->s_str + str->s_length;
+                       str->s_length += RSTRSIZE;
                }
                LoadChar(ch);
        }
@@ -99,7 +104,7 @@ GetString(upto)
 int
 LLlex()
 {
-       /*      LLlex() plays the role of Lexical Analyzer for the parser.
+       /*      LLlex() is the Lexical Analyzer.
                The putting aside of tokens is taken into account.
        */
        register struct token *tk = &dot;
@@ -199,7 +204,7 @@ again:
                register struct idf *id;
 
                do      {
-                       if (tg - buf < IDFSIZE) *tg++ = ch;
+                       if (tg - buf < idfsize) *tg++ = ch;
                        LoadChar(ch);
                } while(in_idf(ch));
 
index 31ddcd4..16ea9e0 100644 (file)
@@ -3,7 +3,7 @@
 /* $Header$ */
 
 struct string {
-       int s_length;           /* length of a string */
+       unsigned int s_length;  /* length of a string */
        char *s_str;            /* the string itself */
 };
 
index 7cb3954..8ce1097 100644 (file)
@@ -12,19 +12,20 @@ CC =        cc
 GEN =  LLgen
 GENOPTIONS =
 PROFILE =
-CFLAGS = -DDEBUG $(PROFILE) $(INCLUDES)
+CFLAGS = $(PROFILE) $(INCLUDES)
 LFLAGS = $(PROFILE)
 LOBJ = tokenfile.o program.o declar.o expression.o statement.o
 COBJ = LLlex.o LLmessage.o char.o error.o main.o \
        symbol2str.o tokenname.o idf.o input.o type.o def.o \
        scope.o misc.o enter.o defmodule.o typequiv.o node.o \
-       cstoper.o chk_expr.o
+       cstoper.o chk_expr.o options.o
 OBJ =  $(COBJ) $(LOBJ) Lpars.o
 GENFILES=      tokenfile.c \
        program.c declar.c expression.c statement.c \
        tokenfile.g symbol2str.c char.c Lpars.c Lpars.h
 
 all:
+       make hfiles
        make LLfiles
        make main
 
@@ -32,6 +33,10 @@ LLfiles:     $(LSRC)
        $(GEN) $(GENOPTIONS) $(LSRC)
        @touch LLfiles
 
+hfiles:        Parameters make.hfiles
+       make.hfiles Parameters
+       touch hfiles
+
 main:  $(OBJ) Makefile
        $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libprint.a /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main
        size main
@@ -73,28 +78,28 @@ depend:
        make.allocd < $< > $@
 
 #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h
+LLlex.o: LLlex.h Lpars.h class.h const.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
-error.o: LLlex.h f_info.h input.h main.h node.h
-main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h scope.h standards.h tokenname.h type.h
+error.o: LLlex.h errout.h f_info.h input.h inputtype.h main.h node.h
+main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h standards.h tokenname.h type.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
-input.o: f_info.h input.h
-type.o: LLlex.h const.h debug.h def.h def_sizes.h idf.h node.h type.h
+input.o: f_info.h input.h inputtype.h
+type.o: LLlex.h const.h debug.h def.h idf.h node.h target_sizes.h type.h
 def.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h node.h
 enter.o: LLlex.h def.h idf.h node.h scope.h type.h
-defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h scope.h
+defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.h
 typequiv.o: def.h type.h
 node.o: LLlex.h debug.h def.h node.h type.h
-cstoper.o: LLlex.h Lpars.h def_sizes.h idf.h node.h standards.h type.h
+cstoper.o: LLlex.h Lpars.h idf.h node.h standards.h target_sizes.h type.h
 chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
 declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
 expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h
-statement.o: LLlex.h Lpars.h node.h
+statement.o: LLlex.h Lpars.h node.h type.h
 Lpars.o: Lpars.h
diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
new file mode 100644 (file)
index 0000000..f49d2aa
--- /dev/null
@@ -0,0 +1,60 @@
+!File: errout.h
+#define        ERROUT          STDERR  /* file pointer for writing messages    */
+#define        MAXERR_LINE     5       /* maximum number of error messages given
+                                       on the same input line.         */
+
+
+!File: idfsize.h
+#define        IDFSIZE 30      /* maximum significant length of an identifier  */
+
+
+!File: numsize.h
+#define        NUMSIZE 256     /* maximum length of a numeric constant         */
+
+
+!File: strsize.h
+#define ISTRSIZE       32      /* minimum number of bytes allocated for
+                                       storing a string                */
+#define RSTRSIZE       8       /* step size in enlarging the memory for
+                                       the storage of a string         */
+
+
+!File: target_sizes.h
+#define MAXSIZE                8       /* the maximum of the SZ_* constants    */
+
+/* target machine sizes        */
+#define        SZ_CHAR         (arith)1
+#define        SZ_SHORT        (arith)2
+#define SZ_WORD                (arith)4
+#define        SZ_INT          (arith)4
+#define        SZ_LONG         (arith)4
+#define        SZ_FLOAT        (arith)4
+#define        SZ_DOUBLE       (arith)8
+#define        SZ_POINTER      (arith)4
+
+/* target machine alignment requirements       */
+#define        AL_CHAR         1
+#define        AL_SHORT        SZ_SHORT
+#define AL_WORD                SZ_WORD
+#define        AL_INT          SZ_WORD
+#define        AL_LONG         SZ_WORD
+#define        AL_FLOAT        SZ_WORD
+#define        AL_DOUBLE       SZ_WORD
+#define        AL_POINTER      SZ_WORD
+#define AL_STRUCT      1
+#define AL_UNION       1
+
+
+!File: debug.h
+#define DEBUG          1       /* perform various self-tests           */
+extern char options[];
+#ifdef DEBUG
+#define DO_DEBUG(n, x) ((n) <= options['D'] && (x))
+#else
+#define DO_DEBUG(n, x)
+#endif DEBUG
+
+!File: inputtype.h
+#undef INP_READ_IN_ONE 1       /* read input file in one       */
+
+
index fdd55cb..95ecf20 100644 (file)
@@ -79,7 +79,7 @@ chk_set(expp)
        if (expp->nd_left) {
                /* A type was given. Check it out
                */
-               (void) findname(expp->nd_left);
+               findname(expp->nd_left);
                assert(expp->nd_left->nd_class == Def);
                df = expp->nd_left->nd_def;
                if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) ||
@@ -93,7 +93,7 @@ chk_set(expp)
 
        /* Now check the elements given, and try to compute a constant set.
        */
-       set = (arith *) Malloc(tp->tp_size * sizeof(arith) / wrd_size);
+       set = (arith *) Malloc(tp->tp_size * sizeof(arith) / word_size);
        nd = expp->nd_right;
        while (nd) {
                assert(nd->nd_class == Link && nd->nd_symb == ',');
@@ -149,7 +149,7 @@ node_error(expp, "Lower bound exceeds upper bound in range");
                        }
                }
                else if (*set) {
-                       free(*set);
+                       free((char *) *set);
                        *set = 0;
                }
                return 1;
@@ -223,7 +223,7 @@ getname(argp, kinds)
                return 0;
        }
        argp = argp->nd_right;
-       if (!findname(argp->nd_left)) return 0;
+       findname(argp->nd_left);
        assert(argp->nd_left->nd_class == Def);
        if (!(argp->nd_left->nd_def->df_kind & kinds)) {
                node_error(argp, "Unexpected type");
@@ -244,8 +244,8 @@ chk_call(expp)
        register struct node *arg;
 
        expp->nd_type = error_type;
-       (void) findname(expp->nd_left); /* parser made sure it is a name */
        left = expp->nd_left;
+       findname(left);
 
        if (left->nd_type == error_type) return 0;
        if (left->nd_class == Def &&
@@ -451,8 +451,8 @@ findname(expp)
                scope.
        */
        register struct def *df;
-       struct def *lookfor();
        register struct type *tp;
+       struct def *lookfor();
 
        expp->nd_type = error_type;
        if (expp->nd_class == Name) {
@@ -498,18 +498,18 @@ df->df_idf->id_text);
        }
        if (expp->nd_class == Oper) {
                assert(expp->nd_symb == '[');
-               (void) findname(expp->nd_left);
-               if (chk_expr(expp->nd_right, 0) &&
+               findname(expp->nd_left);
+               if (chk_expr(expp->nd_right) &&
                    expp->nd_left->nd_type != error_type &&
                    chk_oper(expp)) /* ??? */ ;
-               return 1;
+               return;
        }
        if (expp->nd_class == Uoper && expp->nd_symb == '^') {
-               (void) findname(expp->nd_right);
+               findname(expp->nd_right);
                if (expp->nd_right->nd_type != error_type &&
                        chk_uoper(expp)) /* ??? */ ;
        }
-       return 0;
+       return;
 }
 
 int
@@ -518,7 +518,7 @@ chk_name(expp)
 {
        register struct def *df;
 
-       (void) findname(expp);
+       findname(expp);
        assert(expp->nd_class == Def);
        df = expp->nd_def;
        if (df->df_kind == D_ERROR) return 0;
index 81411b2..be2ba57 100644 (file)
@@ -5,7 +5,9 @@ static char *RcsId = "$Header$";
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
-#include       "def_sizes.h"
+
+#include       "target_sizes.h"
+
 #include       "idf.h"
 #include       "type.h"
 #include       "LLlex.h"
@@ -211,7 +213,7 @@ cstset(expp)
        assert(expp->nd_right->nd_class == Set);
        assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
        set2 = expp->nd_right->nd_set;
-       setsize = expp->nd_right->nd_type->tp_size / wrd_size;
+       setsize = expp->nd_right->nd_type->tp_size / word_size;
 
        if (expp->nd_symb == IN) {
                arith i;
@@ -359,7 +361,8 @@ cstcall(expp, call)
                cut_size(expp);
                break;
        case S_SIZE:
-               expp->nd_INT = align(expr->nd_type->tp_size, wrd_size)/wrd_size;
+               expp->nd_INT = align(expr->nd_type->tp_size, (int) word_size) /
+                               word_size;
                break;
        case S_VAL:
                expp->nd_INT = expr->nd_INT;
@@ -435,12 +438,12 @@ init_cst()
        }
        mach_long_size = i;
        mach_long_sign = 1 << (mach_long_size * 8 - 1);
-       if (lint_size > mach_long_size) {
+       if (long_size > mach_long_size) {
                fatal("sizeof (long) insufficient on this machine");
        }
 
        max_int = full_mask[int_size] & ~(1 << (int_size * 8 - 1));
        max_unsigned = full_mask[int_size];
-       max_longint = full_mask[lint_size] & ~(1 << (lint_size * 8 - 1));
-       wrd_bits = 8 * wrd_size;
+       max_longint = full_mask[long_size] & ~(1 << (long_size * 8 - 1));
+       wrd_bits = 8 * word_size;
 }
index afedfbb..8e5dbcd 100644 (file)
@@ -25,7 +25,7 @@ ProcedureDeclaration
        ProcedureHeading(&df, D_PROCEDURE)
                        { df->prc_level = proclevel++;
                        }
-       ';' block IDENT
+       ';' block(&(df->prc_body)) IDENT
                        { match_id(dot.TOK_IDF, df->df_idf);
                          df->prc_scope = CurrentScope;
                          close_scope(SC_CHKFORW);
@@ -68,11 +68,17 @@ error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
                }
 ;
 
-block
+block(struct node **pnd;)
 {
-       struct node *nd;
 }:
-       declaration* [ BEGIN StatementSequence(&nd) ]? END
+       declaration*
+       [
+               BEGIN
+               StatementSequence(pnd)
+       |
+                       { *pnd = 0; }
+       ]
+       END
 ;
 
 declaration:
@@ -101,7 +107,7 @@ FormalParameters(int doparams;
                        { pr1 = *pr; }
                [
                        { for (; pr1->next; pr1 = pr1->next) ; }
-                       ';' FPSection(doparams, &(pr1->next), &parmaddr)
+                       ';' FPSection(doparams, &(pr1->next), parmaddr)
                ]*
        ]?
        ')'
@@ -149,8 +155,8 @@ FormalType(struct type **tp;)
                        { if (ARRAYflag) {
                                *tp = construct_type(T_ARRAY, NULLTYPE);
                                (*tp)->arr_elem = df->df_type;
-                               (*tp)->tp_align = lcm(wrd_align, ptr_align);
-                               (*tp)->tp_size = align(ptr_size + 3*wrd_size,
+                               (*tp)->tp_align = lcm(word_align, pointer_align);
+                               (*tp)->tp_size = align(pointer_size + 3*word_size,
                                                        (*tp)->tp_align);
                          }
                          else  *tp = df->df_type;
@@ -221,17 +227,17 @@ enumeration(struct type **ptp;)
 } :
        '(' IdentList(&EnumList) ')'
                {
-                 *ptp = standard_type(T_ENUMERATION,1,1);
+                 *ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
                  EnterIdList(EnumList, D_ENUM, 0, *ptp,
                                CurrentScope, (arith *) 0);
                  FreeNode(EnumList);
                  if ((*ptp)->enm_ncst > 256) {
-                       if (wrd_size == 1) {
+                       if (word_size == 1) {
                                error("Too many enumeration literals");
                        }
                        else {
-                               (*ptp)->tp_size = wrd_size;
-                               (*ptp)->tp_align = wrd_align;
+                               (*ptp)->tp_size = word_size;
+                               (*ptp)->tp_align = word_align;
                        }
                  }
                }
@@ -291,7 +297,7 @@ RecordType(struct type **ptp;)
 {
        struct scope *scope;
        arith count;
-       int xalign = record_align;
+       int xalign = struct_align;
 }
 :
        RECORD
@@ -391,28 +397,43 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
 {
        struct type *tp1 = tp;
+       struct node *nd;
 } :
        [
-               CaseLabelList(&tp1) ':' FieldListSequence(scope, cnt, palign)
+               CaseLabelList(&tp1, &nd)
+                               { /* Ignore the cases for the time being.
+                                    Maybe a checking version will be supplied
+                                    later ???
+                                 */
+                                 FreeNode(nd);
+                               }
+               ':' FieldListSequence(scope, cnt, palign)
        ]?
                                        /* Changed rule in new modula-2 */
 ;
 
-CaseLabelList(struct type **ptp;):
-       CaseLabels(ptp) [ ',' CaseLabels(ptp) ]*
+CaseLabelList(struct type **ptp; struct node **pnd;):
+       CaseLabels(ptp, pnd)
+       [       
+                       { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
+               ',' CaseLabels(ptp, &((*pnd)->nd_right))
+                       { pnd = &((*pnd)->nd_right); }
+       ]*
 ;
 
-CaseLabels(struct type **ptp;)
+CaseLabels(struct type **ptp; struct node **pnd;)
 {
        struct node *nd1, *nd2 = 0;
 }:
-       ConstExpression(&nd1)
+       ConstExpression(&nd1)   { *pnd = nd1; }
        [
-               UPTO ConstExpression(&nd2)
+               UPTO            { *pnd = MkNode(Link,nd1,NULLNODE,&dot); }
+               ConstExpression(&nd2)
                                { if (!TstCompat(nd1->nd_type, nd2->nd_type)) {
 node_error(nd2,"type incompatibility in case label");
                                  }
                                  nd1->nd_type = error_type;
+                                 (*pnd)->nd_right = nd2;
                                }
        ]?
                                { if (*ptp != 0 &&
index 6a76293..f2705a9 100644 (file)
@@ -3,10 +3,12 @@
 /* $Header$ */
 
 struct module {
-       int mo_priority;        /* priority of a module */
+       arith mo_priority;      /* priority of a module */
        struct scope *mo_scope; /* scope of this module */
+       struct node *mo_body;   /* body of this module */
 #define mod_priority   df_value.df_module.mo_priority
 #define mod_scope      df_value.df_module.mo_scope
+#define mod_body       df_value.df_module.mo_body
 };
 
 struct variable {
@@ -43,9 +45,11 @@ struct dfproc {
        struct scope *pr_scope; /* scope of procedure */
        int pr_level;           /* depth level of this procedure */
        arith pr_nbpar;         /* Number of bytes parameters */
+       struct node *pr_body;   /* body of this procedure */
 #define prc_scope      df_value.df_proc.pr_scope
 #define prc_level      df_value.df_proc.pr_level
 #define prc_nbpar      df_value.df_proc.pr_nbpar
+#define prc_body       df_value.df_proc.pr_body
 };
 
 struct import {
index e72269c..13eae68 100644 (file)
@@ -9,15 +9,15 @@ static char *RcsId = "$Header$";
 
 #include       <system.h>
 #include       <em_arith.h>
+
+#include       "errout.h"
+
 #include       "input.h"
 #include       "f_info.h"
 #include       "LLlex.h"
 #include       "main.h"
 #include       "node.h"
 
-#define MAXERR_LINE    5       /* Number of error messages on one line ... */
-#define        ERROUT          STDERR
-
 /* error classes */
 #define        ERROR           1
 #define        WARNING         2
index 550cdc5..abb111c 100644 (file)
@@ -2,6 +2,8 @@
 
 /* $Header$ */
 
+#include       "inputtype.h"
+
 #define INP_NPUSHBACK 2
 #define INP_TYPE       struct f_info
 #define INP_VAR                file_info
index a66d0aa..a135e66 100644 (file)
@@ -28,14 +28,14 @@ char        *getenv();
 main(argc, argv)
        char *argv[];
 {
-       register Nargc = 1;
+       register int Nargc = 1;
        register char **Nargv = &argv[0];
 
        ProgName = *argv++;
 
        while (--argc > 0) {
                if (**argv == '-')
-                       Option(*argv++);
+                       do_option((*argv++) + 1);
                else
                        Nargv[Nargc++] = *argv++;
        }
@@ -71,16 +71,14 @@ Compile(src)
        init_types();
        add_standards();
 #ifdef DEBUG
-       if (options['L']) LexScan();
-       else {
+       if (options['l']) LexScan();
+       else
 #endif DEBUG
+       {
                (void) open_scope(CLOSEDSCOPE);
                GlobalScope = CurrentScope;
                CompUnit();
-#ifdef DEBUG
        }
-       if (options['h']) hash_stat();
-#endif DEBUG
        if (err_occurred) return 0;
        return 1;
 }
@@ -117,12 +115,6 @@ LexScan()
 }
 #endif
 
-Option(str)
-       char *str;
-{
-       options[str[1]]++;      /* switch option on     */
-}
-
 add_standards()
 {
        register struct def *df;
diff --git a/lang/m2/comp/make.hfiles b/lang/m2/comp/make.hfiles
new file mode 100755 (executable)
index 0000000..2132dd6
--- /dev/null
@@ -0,0 +1,35 @@
+: Update Files from database
+
+PATH=/bin:/usr/bin
+
+case $# in
+1) ;;
+*)     echo use: $0 file >&2
+       exit 1
+esac
+
+(
+IFCOMMAND="if (<\$FN) 2>/dev/null;\
+       then    if cmp -s \$FN \$TMP;\
+               then    rm \$TMP;\
+               else    mv \$TMP \$FN;\
+                       echo update \$FN;\
+               fi;\
+       else    mv \$TMP \$FN;\
+               echo create \$FN;\
+       fi"
+echo 'TMP=.uf$$'
+echo 'FN=$TMP'
+echo 'cat >$TMP <<\!EOF!'
+sed -n '/^!File:/,${
+/^$/d
+/^!File:[       ]*\(.*\)$/s@@!EOF!\
+'"$IFCOMMAND"'\
+FN=\1\
+cat >$TMP <<\\!EOF!@
+p
+}' $1
+echo '!EOF!'
+echo $IFCOMMAND
+) |
+sh
diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
new file mode 100644 (file)
index 0000000..f8bc488
--- /dev/null
@@ -0,0 +1,114 @@
+/* U S E R   O P T I O N - H A N D L I N G */
+
+static char *RcsId = "$Header$";
+
+#include       <em_arith.h>
+#include       <em_label.h>
+
+#include       "idfsize.h"
+
+#include       "type.h"
+
+extern char options[];
+extern int     idfsize;
+
+do_option(text)
+       char *text;
+{
+       switch(*text++) {
+
+       default:
+               options[text[-1]] = 1;  /* flags, debug options etc.    */
+               break;
+
+       case 'L' :
+               warning("-L: default no EM profiling; use -p for EM profiling");
+               break;
+
+       case 'M':       /* maximum identifier length */
+               idfsize = txt2int(&text);
+               if (*text || idfsize <= 0)
+                       fatal("malformed -M option");
+               if (idfsize > IDFSIZE)
+                       fatal("maximum identifier length is %d", IDFSIZE);
+               break;
+
+       case 'p' :      /* generate profiling code (fil/lin) */
+               options['p'] = 1;
+               break;
+
+       case 'V' :      /* set object sizes and alignment requirements  */
+       {
+               arith size;
+               int align;
+               char c;
+
+               while (c = *text++)     {
+                       size = txt2int(&text);
+                       align = 0;
+                       if (*text == '.')       {
+                               text++;
+                               align = txt2int(&text);
+                       }
+                       switch (c)      {
+
+                       case 'w':       /* word         */
+                               if (size != (arith)0) word_size = size;
+                               if (align != 0) word_align = align;
+                               break;
+                       case 'i':       /* int          */
+                               if (size != (arith)0) int_size = size;
+                               if (align != 0) int_align = align;
+                               break;
+                       case 'l':       /* longint      */
+                               if (size != (arith)0) long_size = size;
+                               if (align != 0) long_align = align;
+                               break;
+                       case 'f':       /* real         */
+                               if (size != (arith)0) float_size = size;
+                               if (align != 0) float_align = align;
+                               break;
+                       case 'd':       /* longreal     */
+                               if (size != (arith)0) double_size = size;
+                               if (align != 0) double_align = align;
+                               break;
+                       case 'p':       /* pointer      */
+                               if (size != (arith)0) pointer_size = size;
+                               if (align != 0) pointer_align = align;
+                               break;
+                       case 'S':       /* initial record alignment     */
+                               if (align != (arith)0) struct_align = align;
+                               break;
+                       default:
+                               error("-V: bad type indicator %c\n", c);
+                       }
+               }
+               break;
+       }
+
+       case 'n':
+               options['n'] = 1;       /* use no registers     */
+               break;
+
+       case 'w':
+               options['w'] = 1;       /* no warnings will be given    */
+               break;
+       }
+}
+
+int
+txt2int(tp)
+       char **tp;
+{
+       /*      the integer pointed to by *tp is read, while increasing
+               *tp; the resulting value is yielded.
+       */
+       register int val = 0;
+       register int ch;
+       
+       while (ch = **tp, ch >= '0' && ch <= '9')       {
+               val = val * 10 + ch - '0';
+               (*tp)++;
+       }
+       return val;
+}
index e3c6bb7..07930f4 100644 (file)
@@ -43,7 +43,7 @@ static int DEFofIMPL = 0;     /* Flag indicating that we are currently
 ModuleDeclaration
 {
        struct idf *id;
-       struct def *df;
+       register struct def *df;
 } :
        MODULE IDENT            {
                                  id = dot.TOK_IDF;
@@ -57,20 +57,27 @@ ModuleDeclaration
                                        standard_type(T_RECORD, 0, (arith) 0);
                                  df->df_type->rec_scope = df->mod_scope;
                                }
-       priority? ';'
+       priority(&(df->mod_priority))?
+       ';'
        import(1)*
        export(0)?
-       block
+       block(&(df->mod_body))
        IDENT                   { close_scope(SC_CHKFORW|SC_CHKPROC);
                                  match_id(id, dot.TOK_IDF);
                                }
 ;
 
-priority
+priority(arith *pprio;)
 {
        struct node *nd;
-}:
+} :
        '[' ConstExpression(&nd) ']'
+                               { if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
+                                       node_error(nd, "Illegal priority");
+                                 }
+                                 *pprio = nd->nd_INT;
+                                 FreeNode(nd);
+                               }
 ;
 
 export(int def;)
@@ -161,7 +168,7 @@ definition
 {
        struct def *df;
 } :
-       CONST [ ConstantDeclaration ';' ]*
+       CONST [ ConstantDeclaration Semicolon ]*
 |
        TYPE
        [ IDENT         { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
@@ -175,38 +182,48 @@ definition
                        { df->df_kind = D_HIDDEN;
                        }
          ]
-         ';'
+         Semicolon
        ]*
 |
-       VAR [ VariableDeclaration ';' ]*
+       VAR [ VariableDeclaration Semicolon ]*
 |
-       ProcedureHeading(&df, D_PROCHEAD) ';'
+       ProcedureHeading(&df, D_PROCHEAD) Semicolon
+;
+
+Semicolon:
+       ';'
+|
+                       { warning("; expected"); }
 ;
 
 ProgramModule(int state;)
 {
        struct idf *id;
-       struct def *df, *GetDefinitionModule();
-       struct scope *scope = 0;
+       struct def *GetDefinitionModule();
+       register struct def *df;
 } :
        MODULE
-       IDENT           { 
-                         id = dot.TOK_IDF;
-                         if (state == IMPLEMENTATION) {
-                               DEFofIMPL = 1;
-                               df = GetDefinitionModule(id);
-                               CurrentScope = df->mod_scope;
-                               DEFofIMPL = 0;
-                               DefinitionModule = 0;
-                         }
-                         else  open_scope(CLOSEDSCOPE);
-                       }
-       priority?
+       IDENT   { 
+                 id = dot.TOK_IDF;
+                 if (state == IMPLEMENTATION) {
+                       DEFofIMPL = 1;
+                       df = GetDefinitionModule(id);
+                       CurrentScope = df->mod_scope;
+                       DEFofIMPL = 0;
+                       DefinitionModule = 0;
+                 }
+                 else {
+                       df = define(id, CurrentScope, D_MODULE);
+                       open_scope(CLOSEDSCOPE);
+                       df->mod_scope = CurrentScope;
+                 }
+               }
+       priority(&(df->mod_priority))?
        ';' import(0)*
-       block IDENT
-                       { close_scope(SC_CHKFORW|SC_CHKPROC);
-                         match_id(id, dot.TOK_IDF);
-                       }
+       block(&(df->mod_body)) IDENT
+               { close_scope(SC_CHKFORW|SC_CHKPROC);
+                 match_id(id, dot.TOK_IDF);
+               }
        '.'
 ;
 
index ca60868..79ebb5f 100644 (file)
@@ -23,7 +23,6 @@ open_scope(scopetype)
        /*      Open a scope that is either open (automatic imports) or closed.
        */
        register struct scope *sc = new_scope();
-       register struct scope *sc1;
 
        assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
        sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
@@ -161,6 +160,24 @@ rem_forwards(fo)
        }
 }
 
+Reverse(pdf)
+       register struct def **pdf;
+{
+       /*      Reverse the order in the list of definitions in a scope.
+               This is neccesary because this list is built in reverse.
+       */
+       register struct def *df, *df1;
+
+       df = 0;
+       df1 = *pdf;
+       while (df1) {
+               df1 = df1->df_nextinscope;
+               (*pdf)->df_nextinscope = df;
+               df = *pdf;
+               *pdf = df1;
+       }
+}
+
 close_scope(flag)
 {
        /*      Close a scope. If "flag" is set, check for forward declarations,
@@ -177,6 +194,7 @@ close_scope(flag)
                DO_DEBUG(2, PrScopeDef(sc->sc_def));
                if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
                if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
+               Reverse(&(sc->sc_def));
        }
        CurrentScope = sc->next;
 }
index 36596be..c30e66b 100644 (file)
@@ -4,7 +4,9 @@
 static char *RcsId = "$Header$";
 
 #include       <em_arith.h>
+#include       <em_label.h>
 #include       "LLlex.h"
+#include       "type.h"
 #include       "node.h"
 
 static int     loopcount = 0;  /* Count nested loops */
@@ -12,7 +14,7 @@ static int    loopcount = 0;  /* Count nested loops */
 
 statement(struct node **pnd;)
 {
-       struct node *nd1;
+       register struct node *nd;
 } :
                                { *pnd = 0; }
 [
@@ -21,16 +23,16 @@ statement(struct node **pnd;)
         * states : assignment | ProcedureCall | ...
         * but this gives LL(1) conflicts
         */
-       designator(&nd1)
-       [                       { nd1 = MkNode(Call, nd1, NULLNODE, &dot);
-                                 nd1->nd_symb = '(';
+       designator(pnd)
+       [                       { nd = MkNode(Call, *pnd, NULLNODE, &dot);
+                                 nd->nd_symb = '(';
                                }
-               ActualParameters(&(nd1->nd_right))?
+               ActualParameters(&(nd->nd_right))?
        |
-               BECOMES         { nd1 = MkNode(Stat, nd1, NULLNODE, &dot); }
-               expression(&(nd1->nd_right))
+               BECOMES         { nd = MkNode(Stat, *pnd, NULLNODE, &dot); }
+               expression(&(nd->nd_right))
        ]
-                               { *pnd = nd1; }
+                               { *pnd = nd; }
        /*
         * end of changed part
         */
@@ -58,9 +60,9 @@ statement(struct node **pnd;)
                          *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
                        }
 |
-       RETURN          { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       RETURN          { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
        [
-               expression(&((*pnd)->nd_right))
+               expression(&(nd->nd_right))
        ]?
 ]?
 ;
@@ -138,7 +140,7 @@ CaseStatement(struct node **pnd;)
 
 case(struct node **pnd; struct type **ptp;) :
                        { *pnd = 0; }
-       [ CaseLabelList(ptp/*,pnd*/)
+       [ CaseLabelList(ptp, pnd)
          ':'           { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
          StatementSequence(&((*pnd)->nd_right))
        ]?
index 38c8a96..c2824a8 100644 (file)
@@ -102,21 +102,21 @@ extern struct type
        *error_type;            /* All from type.c */
 
 extern int
-       wrd_align,
+       word_align,
        int_align,
-       lint_align,
-       real_align,
-       lreal_align,
-       ptr_align,
-       record_align;           /* All from type.c */
+       long_align,
+       float_align,
+       double_align,
+       pointer_align,
+       struct_align;           /* All from type.c */
 
 extern arith
-       wrd_size,
+       word_size,
        int_size,
-       lint_size,
-       real_size,
-       lreal_size,
-       ptr_size;               /* All from type.c */
+       long_size,
+       float_size,
+       double_size,
+       pointer_size;           /* All from type.c */
 
 extern arith
        align();                /* type.c */
index 5792379..5813999 100644 (file)
@@ -6,34 +6,36 @@ static char *RcsId = "$Header$";
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
-#include       "def_sizes.h"
+
+#include       "target_sizes.h"
+#include       "debug.h"
+
 #include       "def.h"
 #include       "type.h"
 #include       "idf.h"
 #include       "LLlex.h"
 #include       "node.h"
 #include       "const.h"
-#include       "debug.h"
 
 /*     To be created dynamically in main() from defaults or from command
        line parameters.
 */
 int
-       wrd_align = AL_WORD,
+       word_align = AL_WORD,
        int_align = AL_INT,
-       lint_align = AL_LONG,
-       real_align = AL_FLOAT,
-       lreal_align = AL_DOUBLE,
-       ptr_align = AL_POINTER,
-       record_align = AL_STRUCT;
+       long_align = AL_LONG,
+       float_align = AL_FLOAT,
+       double_align = AL_DOUBLE,
+       pointer_align = AL_POINTER,
+       struct_align = AL_STRUCT;
 
 arith
-       wrd_size = SZ_WORD,
+       word_size = SZ_WORD,
        int_size = SZ_INT,
-       lint_size = SZ_LONG,
-       real_size = SZ_FLOAT,
-       lreal_size = SZ_DOUBLE,
-       ptr_size = SZ_POINTER;
+       long_size = SZ_LONG,
+       float_size = SZ_FLOAT,
+       double_size = SZ_DOUBLE,
+       pointer_size = SZ_POINTER;
 
 struct type
        *bool_type,
@@ -83,12 +85,12 @@ construct_type(fund, tp)
        switch (fund)   {
        case T_PROCEDURE:
        case T_POINTER:
-               dtp->tp_align = ptr_align;
-               dtp->tp_size = ptr_size;
+               dtp->tp_align = pointer_align;
+               dtp->tp_size = pointer_size;
                dtp->next = tp;
                break;
        case T_SET:
-               dtp->tp_align = wrd_align;
+               dtp->tp_align = word_align;
                dtp->next = tp;
                break;
        case T_ARRAY:
@@ -135,17 +137,17 @@ init_types()
        bool_type = standard_type(T_ENUMERATION, 1, (arith) 1);
        bool_type->enm_ncst = 2;
        int_type = standard_type(T_INTEGER, int_align, int_size);
-       longint_type = standard_type(T_INTEGER, lint_align, lint_size);
+       longint_type = standard_type(T_INTEGER, long_align, long_size);
        card_type = standard_type(T_CARDINAL, int_align, int_size);
-       real_type = standard_type(T_REAL, real_align, real_size);
-       longreal_type = standard_type(T_REAL, lreal_align, lreal_size);
-       word_type = standard_type(T_WORD, wrd_align, wrd_size);
+       real_type = standard_type(T_REAL, float_align, float_size);
+       longreal_type = standard_type(T_REAL, double_align, double_size);
+       word_type = standard_type(T_WORD, word_align, word_size);
        intorcard_type = standard_type(T_INTORCARD, int_align, int_size);
        string_type = standard_type(T_STRING, 1, (arith) -1);
        address_type = construct_type(T_POINTER, word_type);
        tp = construct_type(T_SUBRANGE, int_type);
        tp->sub_lb = 0;
-       tp->sub_ub = wrd_size * 8 - 1;
+       tp->sub_ub = word_size * 8 - 1;
        bitset_type = set_type(tp);
        std_type = construct_type(T_PROCEDURE, NULLTYPE);
        error_type = standard_type(T_CHAR, 1, (arith) 1);
@@ -265,7 +267,7 @@ set_type(tp)
        /*      Construct a set type with base type "tp", but first
                perform some checks
        */
-       int lb, ub;
+       arith lb, ub;
 
        if (tp->tp_fund == T_SUBRANGE) {
                if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAX_SET - 1) {
@@ -285,7 +287,7 @@ set_type(tp)
                return error_type;
        }
        tp = construct_type(T_SET, tp);
-       tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
+       tp->tp_size = align(((ub - lb) + 7)/8, word_align);
        return tp;
 }
 
@@ -346,13 +348,9 @@ gcd(m, n)
 
 int
 lcm(m, n)
-       register int m, n;
+       int m, n;
 {
        /*      Least Common Multiple
        */
-       while (m != n) {
-               if (m < n) m = m + m;
-               else n = n + n;
-       }
-       return n;               /* or m */
+       return m * (n / gcd(m, n));
 }