d0p1/ack
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

removed the limitation on number of include directories,

Browse source 
some bug fixes,
sets now have a constant and a variable part
This commit is contained in:
ceriel 1987-05-11 14:38:37 +00:00
parent b3d24d4ec2
commit 927a5636bd
10 changed files with 102 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lang/m2/comp/Makefile
View file

@ -41,7 +41,7 @@ GENCFILES= tokenfile.c \
GENGFILES= tokenfile.g GENGFILES= tokenfile.g
GENHFILES= errout.h\ GENHFILES= errout.h\
idfsize.h numsize.h strsize.h target_sizes.h \ idfsize.h numsize.h strsize.h target_sizes.h \
inputtype.h maxset.h ndir.h density.h\ inputtype.h maxset.h density.h\
def.h debugcst.h type.h Lpars.h node.h def.h debugcst.h type.h Lpars.h node.h
HFILES= LLlex.h\ HFILES= LLlex.h\
chk_expr.h class.h const.h debug.h desig.h f_info.h idf.h\ chk_expr.h class.h const.h debug.h desig.h f_info.h idf.h\
@ -164,6 +164,7 @@ error.o: node.h
error.o: warning.h error.o: warning.h
main.o: LLlex.h main.o: LLlex.h
main.o: Lpars.h main.o: Lpars.h
main.o: SYSTEM.h
main.o: debug.h main.o: debug.h
main.o: debugcst.h main.o: debugcst.h
main.o: def.h main.o: def.h
@ -171,7 +172,6 @@ main.o: f_info.h
main.o: idf.h main.o: idf.h
main.o: input.h main.o: input.h
main.o: inputtype.h main.o: inputtype.h
main.o: ndir.h
main.o: node.h main.o: node.h
main.o: scope.h main.o: scope.h
main.o: standards.h main.o: standards.h
@ -288,7 +288,6 @@ chk_expr.o: type.h
chk_expr.o: warning.h chk_expr.o: warning.h
options.o: idfsize.h options.o: idfsize.h
options.o: main.h options.o: main.h
options.o: ndir.h
options.o: type.h options.o: type.h
options.o: warning.h options.o: warning.h
walk.o: LLlex.h walk.o: LLlex.h

4
lang/m2/comp/Parameters
View file

@ -57,9 +57,5 @@
but what is a reasonable choice ??? but what is a reasonable choice ???
*/ */
!File: ndir.h
#define NDIRS 16 /* maximum number of directories searched */
!File: density.h !File: density.h
#define DENSITY 3 /* see casestat.C for an explanation */ #define DENSITY 3 /* see casestat.C for an explanation */

92
lang/m2/comp/chk_expr.c
View file

@ -63,6 +63,10 @@ ChkVariable(expp)
Xerror(expp, "variable expected", expp->nd_def); Xerror(expp, "variable expected", expp->nd_def);
return 0; return 0;
} }
if (expp->nd_class == Value) {
node_error(expp, "variable expected");
return 0;
}
return 1; return 1;
} }
@ -182,14 +186,18 @@ ChkLinkOrName(expp)
if (! ChkDesignator(left)) return 0; if (! ChkDesignator(left)) return 0;
if (left->nd_type->tp_fund != T_RECORD || if (left->nd_class == Def &&
(left->nd_class == Def && (left->nd_type->tp_fund != T_RECORD ||
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
) )
) { ) {
Xerror(left, "illegal selection", left->nd_def); Xerror(left, "illegal selection", left->nd_def);
return 0; return 0;
} }
if (left->nd_type->tp_fund != T_RECORD) {
node_error(left, "illegal selection");
return 0;
}
if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, 1))) { if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, 1))) {
id_not_declared(expp); id_not_declared(expp);
@ -273,8 +281,8 @@ node_error(expp, "standard or local procedures may not be assigned");
} }
STATIC int STATIC int
ChkElement(expp, tp, set) ChkElement(expp, tp, set, level)
register struct node *expp; struct node **expp;
register struct type *tp; register struct type *tp;
arith **set; arith **set;
{ {
@ -282,15 +290,17 @@ ChkElement(expp, tp, set)
recursively. recursively.
Also try to compute the set! Also try to compute the set!
*/ */
register struct node *left = expp->nd_left; register struct node *expr = *expp;
register struct node *right = expp->nd_right; register struct node *left = expr->nd_left;
register struct node *right = expr->nd_right;
register int i; register int i;
if (expp->nd_class == Link && expp->nd_symb == UPTO) { if (expr->nd_class == Link && expr->nd_symb == UPTO) {
/* { ... , expr1 .. expr2, ... } /* { ... , expr1 .. expr2, ... }
First check expr1 and expr2, and try to compute them. First check expr1 and expr2, and try to compute them.
*/ */
if (!ChkElement(left, tp, set) || !ChkElement(right, tp, set)) { if (!ChkElement(&(expr->nd_left), tp, set, 1) ||
!ChkElement(&(expr->nd_right), tp, set, 1)) {
return 0; return 0;
} }
@ -304,15 +314,11 @@ node_error(expp, "lower bound exceeds upper bound in range");
return 0; return 0;
} }
if (*set) { for (i=left->nd_INT; i<=right->nd_INT; i++) {
for (i=left->nd_INT+1; i<right->nd_INT; i++) { (*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
}
} }
} FreeNode(expr);
else if (*set) { *expp = 0;
free((char *) *set);
*set = 0;
} }
return 1; return 1;
@ -320,27 +326,31 @@ node_error(expp, "lower bound exceeds upper bound in range");
/* Here, a single element is checked /* Here, a single element is checked
*/ */
if (!ChkExpression(expp)) return 0; if (!ChkExpression(expr)) return 0;
if (!TstCompat(tp, expp->nd_type)) { if (!TstCompat(tp, expr->nd_type)) {
node_error(expp, "set element has incompatible type"); node_error(expr, "set element has incompatible type");
return 0; return 0;
} }
if (expp->nd_class == Value) { if (expr->nd_class == Value) {
/* a constant element /* a constant element
*/ */
arith low, high; arith low, high;
i = expp->nd_INT; i = expr->nd_INT;
getbounds(tp, &low, &high); getbounds(tp, &low, &high);
if (i < low || i > high) { if (i < low || i > high) {
node_error(expp, "set element out of range"); node_error(expr, "set element out of range");
return 0; return 0;
} }
if (*set) (*set)[i/wrd_bits] |= (1 << (i%wrd_bits)); if (! level) {
(*set)[i/wrd_bits] |= (1 << (i%wrd_bits));
FreeNode(expr);
*expp = 0;
}
} }
return 1; return 1;
@ -356,11 +366,13 @@ ChkSet(expp)
register struct type *tp; register struct type *tp;
register struct node *nd; register struct node *nd;
register struct def *df; register struct def *df;
arith *set;
unsigned size; unsigned size;
int retval = 1;
assert(expp->nd_symb == SET); assert(expp->nd_symb == SET);
expp->nd_class = Set;
/* First determine the type of the set /* First determine the type of the set
*/ */
if (nd = expp->nd_left) { if (nd = expp->nd_left) {
@ -392,37 +404,31 @@ ChkSet(expp)
if (! nd) { if (! nd) {
/* The resulting set IS empty, so we just return /* The resulting set IS empty, so we just return
*/ */
expp->nd_class = Set;
expp->nd_set = 0; expp->nd_set = 0;
return 1; return 1;
} }
size = tp->tp_size * (sizeof(arith) / word_size); size = tp->tp_size * (sizeof(arith) / word_size);
set = (arith *) Malloc(size); expp->nd_set = (arith *) Malloc(size);
clear((char *) set, size); clear((char *) (expp->nd_set) , size);
/* Now check the elements, one by one /* Now check the elements, one by one
*/ */
while (nd) { while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ','); assert(nd->nd_class == Link && nd->nd_symb == ',');
if (!ChkElement(nd->nd_left, ElementType(tp), &set)) return 0; if (!ChkElement(&(nd->nd_left), ElementType(tp),
&(expp->nd_set), 0)) {
retval = 0;
}
if (nd->nd_left) expp->nd_class = Xset;
nd = nd->nd_right; nd = nd->nd_right;
} }
if (set) { if (expp->nd_class == Set) {
/* Yes, it was a constant set, and we managed to compute it!
Notice that at the moment there is no such thing as
partial evaluation. Either we evaluate the set, or we
don't (at all). Improvement not neccesary (???)
??? sets have a contant part and a variable part ???
*/
expp->nd_class = Set;
expp->nd_set = set;
FreeNode(expp->nd_right); FreeNode(expp->nd_right);
expp->nd_right = 0; expp->nd_right = 0;
} }
return retval;
return 1;
} }
STATIC struct node * STATIC struct node *
@ -814,10 +820,8 @@ ChkUnOper(expp)
switch(expp->nd_symb) { switch(expp->nd_symb) {
case '+': case '+':
if (tpr->tp_fund & T_NUMERIC) { if (tpr->tp_fund & T_NUMERIC) {
expp->nd_token = right->nd_token; *expp = *right;
expp->nd_class = right->nd_class; free_node(right);
FreeNode(right);
expp->nd_right = 0;
return 1; return 1;
} }
break; break;

10
lang/m2/comp/code.c
View file

@ -140,6 +140,7 @@ CodeExpr(nd, ds, true_label, false_label)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
break; break;
case Xset:
case Set: { case Set: {
register arith *st = nd->nd_set; register arith *st = nd->nd_set;
register int i; register int i;
@ -153,14 +154,10 @@ CodeExpr(nd, ds, true_label, false_label)
for (i = tp->tp_size / word_size, st += i; i > 0; i--) { for (i = tp->tp_size / word_size, st += i; i > 0; i--) {
C_loc(*--st); C_loc(*--st);
} }
CodeSet(nd);
} }
break; break;
case Xset:
CodeSet(nd);
ds->dsg_kind = DSG_LOADED;
break;
default: default:
crash("(CodeExpr) bad node type"); crash("(CodeExpr) bad node type");
} }
@ -930,12 +927,11 @@ CodeSet(nd)
{ {
register struct type *tp = nd->nd_type; register struct type *tp = nd->nd_type;
C_zer(tp->tp_size); /* empty set */
nd = nd->nd_right; nd = nd->nd_right;
while (nd) { while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ','); assert(nd->nd_class == Link && nd->nd_symb == ',');
CodeEl(nd->nd_left, tp); if (nd->nd_left) CodeEl(nd->nd_left, tp);
nd = nd->nd_right; nd = nd->nd_right;
} }
} }

3
lang/m2/comp/em_m2.6
View file

@ -62,6 +62,9 @@ By default, warnings in class \fBO\fR and \fBW\fR are given.
allow for warning messages whose class is a member of \fIclasses\fR. allow for warning messages whose class is a member of \fIclasses\fR.
.IP \fB\-x\fR .IP \fB\-x\fR
make all procedure names global, so that \fIadb\fR(1) understands them. make all procedure names global, so that \fIadb\fR(1) understands them.
.IP \fB\-i\fR\fInum\fR
maximum number of bits in a set. When not used, a default value is
retained.
.LP .LP
.SH FILES .SH FILES
.IR ~em/lib/em_m2 : .IR ~em/lib/em_m2 :

11
lang/m2/comp/main.c
View file

@ -10,7 +10,6 @@
/* $Header$ */ /* $Header$ */
#include "debug.h" #include "debug.h"
#include "ndir.h"
#include <system.h> #include <system.h>
#include <em_arith.h> #include <em_arith.h>
@ -34,7 +33,8 @@ int state; /* either IMPLEMENTATION or PROGRAM */
char options[128]; char options[128];
int DefinitionModule; int DefinitionModule;
char *ProgName; char *ProgName;
char *DEFPATH[NDIRS+1]; char **DEFPATH;
int nDEF, mDEF;
struct def *Defined; struct def *Defined;
extern int err_occurred; extern int err_occurred;
extern int fp_used; /* set if floating point used */ extern int fp_used; /* set if floating point used */
@ -50,6 +50,9 @@ main(argc, argv)
ProgName = *argv++; ProgName = *argv++;
warning_classes = W_INITIAL; warning_classes = W_INITIAL;
DEFPATH = (char **) Malloc(10 * sizeof(char *));
mDEF = 10;
nDEF = 1;
while (--argc > 0) { while (--argc > 0) {
if (**argv == '-') if (**argv == '-')
@ -60,10 +63,10 @@ main(argc, argv)
Nargv[Nargc] = 0; /* terminate the arg vector */ Nargv[Nargc] = 0; /* terminate the arg vector */
if (Nargc < 2) { if (Nargc < 2) {
fprint(STDERR, "%s: Use a file argument\n", ProgName); fprint(STDERR, "%s: Use a file argument\n", ProgName);
return 1; exit(1);
} }
if (options['x']) c_inp = C_exp; if (options['x']) c_inp = C_exp;
return !Compile(Nargv[1], Nargv[2]); exit(!Compile(Nargv[1], Nargv[2]));
} }
Compile(src, dst) Compile(src, dst)

3
lang/m2/comp/main.h
View file

@ -20,5 +20,6 @@ extern struct def *Defined;
/* definition structure of module defined in this /* definition structure of module defined in this
compilation compilation
*/ */
extern char *DEFPATH[]; /* search path for DEFINITION MODULE's */ extern char **DEFPATH; /* search path for DEFINITION MODULE's */
extern int mDEF, nDEF;
extern int state; /* either IMPLEMENTATION or PROGRAM */ extern int state; /* either IMPLEMENTATION or PROGRAM */

32
lang/m2/comp/options.c
View file

@ -10,7 +10,6 @@
/* $Header$ */ /* $Header$ */
#include "idfsize.h" #include "idfsize.h"
#include "ndir.h"
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
@ -46,6 +45,19 @@ DoOption(text)
options[text[-1]]++; options[text[-1]]++;
break; break;
case 'i': /* # of bits in set */
{
char *t = text;
int val;
extern int maxset;
val = txt2int(&t);
if (val <= 0 || *t) {
error("bad -i flag; use -i<num>");
}
else maxset = val;
break;
}
case 'w': case 'w':
if (*text) { if (*text) {
while (*text) { while (*text) {
@ -100,13 +112,25 @@ DoOption(text)
case 'I' : case 'I' :
if (*text) { if (*text) {
register int i = ndirs++; register int i;
register char *new = text; register char *new = text;
if (++nDEF > mDEF) {
char **n = (char **)
Malloc((10+mDEF)*sizeof(char *));
for (i = 0; i < mDEF; i++) {
n[i] = DEFPATH[i];
}
free((char *) DEFPATH);
DEFPATH = n;
mDEF += 10;
}
i = ndirs++;
while (new) { while (new) {
register char *tmp = DEFPATH[i]; register char *tmp = DEFPATH[i];
if (i >= NDIRS)
fatal("too many -I options");
DEFPATH[i++] = new; DEFPATH[i++] = new;
new = tmp; new = tmp;
} }

5
lang/m2/comp/scope.C
View file

@ -207,7 +207,7 @@ close_scope(flag)
assert(sc != 0); assert(sc != 0);
if (flag) { if (flag) {
DO_DEBUG(options['S'], PrScopeDef(sc->sc_def)); DO_DEBUG(options['S'],(print("List of definitions in currently ended scope:\n"), DumpScope(sc->sc_def)));
if (flag & SC_CHKPROC) chk_proc(sc->sc_def); if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def)); if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
if (flag & SC_REVERSE) Reverse(&(sc->sc_def)); if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
@ -216,10 +216,9 @@ close_scope(flag)
} }
#ifdef DEBUG #ifdef DEBUG
PrScopeDef(df) DumpScope(df)
register struct def *df; register struct def *df;
{ {
print("List of definitions in currently ended scope:\n");
while (df) { while (df) {
PrDef(df); PrDef(df);
df = df->df_nextinscope; df = df->df_nextinscope;

9
lang/m2/comp/type.c
View file

@ -39,6 +39,9 @@ int
pointer_align = AL_POINTER, pointer_align = AL_POINTER,
struct_align = AL_STRUCT; struct_align = AL_STRUCT;
int
maxset = MAXSET;
arith arith
word_size = SZ_WORD, word_size = SZ_WORD,
dword_size = 2 * SZ_WORD, dword_size = 2 * SZ_WORD,
@ -436,7 +439,7 @@ set_type(tp)
getbounds(tp, &lb, &ub); getbounds(tp, &lb, &ub);
if (lb < 0 || ub > MAXSET-1) { if (lb < 0 || ub > maxset-1) {
error("set type limits exceeded"); error("set type limits exceeded");
return error_type; return error_type;
} }
@ -648,7 +651,9 @@ DumpType(tp)
print(" fund:"); print(" fund:");
switch(tp->tp_fund) { switch(tp->tp_fund) {
case T_RECORD: case T_RECORD:
print("RECORD"); break; print("RECORD\n");
DumpScope(tp->rec_scope);
break;
case T_ENUMERATION: case T_ENUMERATION:
print("ENUMERATION; ncst:%d", tp->enm_ncst); break; print("ENUMERATION; ncst:%d", tp->enm_ncst); break;
case T_INTEGER: case T_INTEGER: