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
GENHFILES= errout.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
HFILES= LLlex.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
main.o: LLlex.h
main.o: Lpars.h
main.o: SYSTEM.h
main.o: debug.h
main.o: debugcst.h
main.o: def.h
@ -171,7 +172,6 @@ main.o: f_info.h
main.o: idf.h
main.o: input.h
main.o: inputtype.h
main.o: ndir.h
main.o: node.h
main.o: scope.h
main.o: standards.h
@ -288,7 +288,6 @@ chk_expr.o: type.h
chk_expr.o: warning.h
options.o: idfsize.h
options.o: main.h
options.o: ndir.h
options.o: type.h
options.o: warning.h
walk.o: LLlex.h

4
lang/m2/comp/Parameters
View file

@ -57,9 +57,5 @@
but what is a reasonable choice ???
*/
!File: ndir.h
#define NDIRS 16 /* maximum number of directories searched */
!File: density.h
#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);
return 0;
}
if (expp->nd_class == Value) {
node_error(expp, "variable expected");
return 0;
}
return 1;
}
@ -182,14 +186,18 @@ ChkLinkOrName(expp)
if (! ChkDesignator(left)) return 0;
if (left->nd_type->tp_fund != T_RECORD ||
(left->nd_class == Def &&
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
if (left->nd_class == Def &&
(left->nd_type->tp_fund != T_RECORD ||
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
)
) {
Xerror(left, "illegal selection", left->nd_def);
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))) {
id_not_declared(expp);
@ -273,8 +281,8 @@ node_error(expp, "standard or local procedures may not be assigned");
}
STATIC int
ChkElement(expp, tp, set)
register struct node *expp;
ChkElement(expp, tp, set, level)
struct node **expp;
register struct type *tp;
arith **set;
{
@ -282,15 +290,17 @@ ChkElement(expp, tp, set)
recursively.
Also try to compute the set!
*/
register struct node *left = expp->nd_left;
register struct node *right = expp->nd_right;
register struct node *expr = *expp;
register struct node *left = expr->nd_left;
register struct node *right = expr->nd_right;
register int i;
if (expp->nd_class == Link && expp->nd_symb == UPTO) {
if (expr->nd_class == Link && expr->nd_symb == UPTO) {
/* { ... , expr1 .. expr2, ... }
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;
}
@ -304,15 +314,11 @@ node_error(expp, "lower bound exceeds upper bound in range");
return 0;
}
if (*set) {
for (i=left->nd_INT+1; i<right->nd_INT; i++) {
(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
}
for (i=left->nd_INT; i<=right->nd_INT; i++) {
(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
}
}
else if (*set) {
free((char *) *set);
*set = 0;
FreeNode(expr);
*expp = 0;
}
return 1;
@ -320,27 +326,31 @@ node_error(expp, "lower bound exceeds upper bound in range");
/* Here, a single element is checked
*/
if (!ChkExpression(expp)) return 0;
if (!ChkExpression(expr)) return 0;
if (!TstCompat(tp, expp->nd_type)) {
node_error(expp, "set element has incompatible type");
if (!TstCompat(tp, expr->nd_type)) {
node_error(expr, "set element has incompatible type");
return 0;
}
if (expp->nd_class == Value) {
if (expr->nd_class == Value) {
/* a constant element
*/
arith low, high;
i = expp->nd_INT;
i = expr->nd_INT;
getbounds(tp, &low, &high);
if (i < low || i > high) {
node_error(expp, "set element out of range");
node_error(expr, "set element out of range");
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;
@ -356,11 +366,13 @@ ChkSet(expp)
register struct type *tp;
register struct node *nd;
register struct def *df;
arith *set;
unsigned size;
int retval = 1;
assert(expp->nd_symb == SET);
expp->nd_class = Set;
/* First determine the type of the set
*/
if (nd = expp->nd_left) {
@ -392,37 +404,31 @@ ChkSet(expp)
if (! nd) {
/* The resulting set IS empty, so we just return
*/
expp->nd_class = Set;
expp->nd_set = 0;
return 1;
}
size = tp->tp_size * (sizeof(arith) / word_size);
set = (arith *) Malloc(size);
clear((char *) set, size);
expp->nd_set = (arith *) Malloc(size);
clear((char *) (expp->nd_set) , size);
/* Now check the elements, one by one
*/
while (nd) {
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;
}
if (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;
if (expp->nd_class == Set) {
FreeNode(expp->nd_right);
expp->nd_right = 0;
}
return 1;
return retval;
}
STATIC struct node *
@ -814,10 +820,8 @@ ChkUnOper(expp)
switch(expp->nd_symb) {
case '+':
if (tpr->tp_fund & T_NUMERIC) {
expp->nd_token = right->nd_token;
expp->nd_class = right->nd_class;
FreeNode(right);
expp->nd_right = 0;
*expp = *right;
free_node(right);
return 1;
}
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;
break;
case Xset:
case Set: {
register arith *st = nd->nd_set;
register int i;
@ -153,12 +154,8 @@ CodeExpr(nd, ds, true_label, false_label)
for (i = tp->tp_size / word_size, st += i; i > 0; i--) {
C_loc(*--st);
}
}
break;
case Xset:
CodeSet(nd);
ds->dsg_kind = DSG_LOADED;
}
break;
default:
@ -930,12 +927,11 @@ CodeSet(nd)
{
register struct type *tp = nd->nd_type;
C_zer(tp->tp_size); /* empty set */
nd = nd->nd_right;
while (nd) {
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;
}
}

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.
.IP \fB\-x\fR
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
.SH FILES
.IR ~em/lib/em_m2 :

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

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

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

@ -10,7 +10,6 @@
/* $Header$ */
#include "idfsize.h"
#include "ndir.h"
#include <em_arith.h>
#include <em_label.h>
@ -46,6 +45,19 @@ DoOption(text)
options[text[-1]]++;
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':
if (*text) {
while (*text) {
@ -100,13 +112,25 @@ DoOption(text)
case 'I' :
if (*text) {
register int i = ndirs++;
register int i;
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) {
register char *tmp = DEFPATH[i];
if (i >= NDIRS)
fatal("too many -I options");
DEFPATH[i++] = new;
new = tmp;
}

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

@ -207,7 +207,7 @@ close_scope(flag)
assert(sc != 0);
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_CHKFORW) chk_forw(&(sc->sc_def));
if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
@ -216,10 +216,9 @@ close_scope(flag)
}
#ifdef DEBUG
PrScopeDef(df)
DumpScope(df)
register struct def *df;
{
print("List of definitions in currently ended scope:\n");
while (df) {
PrDef(df);
df = df->df_nextinscope;

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

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