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

fixes and other mods

Browse source
This commit is contained in:
ceriel 1988-02-17 17:21:51 +00:00
parent 31ed7f7e30
commit 4e0c9a780a
9 changed files with 236 additions and 182 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lang/m2/m2mm/LLlex.c
View file

@ -340,7 +340,11 @@ again:
if (is_hex(ch)) {
state = Hex;
}
else state = End;
else {
ch = 'D';
state = End;
PushBack();
}
break;
case Hex:

130
lang/m2/m2mm/declar.g
View file

@ -20,21 +20,27 @@ ProcedureHeading :
[
';' FPSection
]*
]?
|
]
')'
[ ':' qualtype
]?
]?
[
':' qualtype
|
/* empty */
]
|
/* empty */
]
;
block :
[ %persistent
[ %persistent
declaration
]*
[ %default
BEGIN
StatementSequence
[ %default
BEGIN StatementSequence
|
/* empty */
]
END
;
@ -46,10 +52,7 @@ declaration :
|
VAR [ VariableDeclaration ';' ]*
|
ProcedureHeading ';'
block
IDENT
';'
ProcedureHeading ';' block IDENT ';'
|
ModuleDeclaration ';'
;
@ -65,12 +68,12 @@ FormalType :
;
TypeDeclaration :
IDENT
'=' type
IDENT '=' type
;
type :
%default SimpleType
%default
SimpleType
|
ArrayType
|
@ -86,7 +89,7 @@ type :
SimpleType :
qualtype
[
/* nothing */
/* empty */
|
SubrangeType
/* The subrange type is given a base type by the
@ -115,22 +118,19 @@ SubrangeType :
This is not exactly the rule in the new report, but see
the rule for "SimpleType".
*/
'[' ConstExpression
UPTO ConstExpression
']'
'[' ConstExpression UPTO ConstExpression ']'
;
ArrayType :
ARRAY SimpleType
[
',' SimpleType
]* OF type
]*
OF type
;
RecordType :
RECORD
FieldListSequence
END
RECORD FieldListSequence END
;
FieldListSequence :
@ -141,40 +141,49 @@ FieldListSequence :
;
FieldList :
[
IdentList ':' type
|
CASE
/* Also accept old fashioned Modula-2 syntax, but give a warning.
Sorry for the complicated code.
*/
[ qualident
[ ':' qualtype
[
qualident
[
':' qualtype
/* This is correct, in both kinds of Modula-2, if
the first qualident is a single identifier.
*/
| /* Old fashioned! the first qualident now represents
|
/* empty */
/* Old fashioned! the first qualident now represents
the type
*/
]
| ':' qualtype
/* Aha, third edition. Well done! */
]
|
':' qualtype
/* Aha, third edition. Well done! */
]
OF variant
[
'|' variant
'|' variant
]*
[ ELSE FieldListSequence
]?
[
ELSE FieldListSequence
|
/* empty */
]
END
]?
|
/* empty */
;
variant :
[
CaseLabelList
':' FieldListSequence
]?
CaseLabelList ':' FieldListSequence
|
/* empty */
]
/* Changed rule in new modula-2 */
;
@ -188,9 +197,10 @@ CaseLabelList :
CaseLabels :
ConstExpression
[
UPTO
ConstExpression
]?
UPTO ConstExpression
|
/* empty */
]
;
SetType :
@ -214,6 +224,7 @@ ProcedureType :
[
FormalTypeList
|
/* empty */
]
;
@ -224,29 +235,29 @@ FormalTypeList :
[
',' VarFormalType
]*
]?
')'
[ ':' qualtype
|
/* empty */
]
;
VarFormalType :
var
FormalType
;
var :
[
VAR
')'
[
':' qualtype
|
/* empty */
]
;
VarFormalType :
var FormalType
;
var :
VAR
|
/* empty */
;
ConstantDeclaration :
IDENT
'=' ConstExpression
IDENT '=' ConstExpression
;
VariableDeclaration :
@ -259,8 +270,9 @@ VariableDeclaration :
IdentAddr :
IDENT
[ '['
ConstExpression
']'
]?
[
'[' ConstExpression ']'
|
/* empty */
]
;

46
lang/m2/m2mm/expression.g
View file

@ -25,8 +25,7 @@ selector :
ExpList :
expression
[
','
expression
',' expression
]*
;
@ -43,18 +42,23 @@ expression :
/* relation */
[ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
SimpleExpression
]?
|
/* empty */
]
;
SimpleExpression :
[
[ '+' | '-' ]
]?
'+'
|
'-'
|
/* empty */
]
term
[
/* AddOperator */
[ '+' | '-' | OR ]
term
[ '+' | '-' | OR ] term
]*
;
@ -62,8 +66,7 @@ term :
factor
[
/* MulOperator */
[ '*' | '/' | DIV | MOD | AND ]
factor
[ '*' | '/' | DIV | MOD | AND ] factor
]*
;
@ -73,15 +76,16 @@ factor :
designator_tail?
[
ActualParameters
]?
|
/* empty */
]
|
bare_set
]
|
bare_set
| %default
[
%default
[ %default
INTEGER
|
REAL
@ -101,7 +105,9 @@ bare_set :
[
',' element
]*
]?
|
/* empty */
]
'}'
;
@ -112,20 +118,20 @@ ActualParameters :
element :
expression
[
UPTO
expression
]?
UPTO expression
|
/* empty */
]
;
designator :
qualident
designator_tail?
qualident designator_tail?
;
designator_tail :
visible_designator_tail
[ %persistent
%default
%default
selector
|
visible_designator_tail
@ -133,7 +139,6 @@ designator_tail :
;
visible_designator_tail :
[
'['
expression
[
@ -142,5 +147,4 @@ visible_designator_tail :
']'
|
'^'
]
;

4
lang/m2/m2mm/f_info.h
View file

@ -11,11 +11,11 @@
struct f_info {
unsigned short f_lineno;
char *f_filename;
char *f_fn;
char *f_workingdir;
};
extern struct f_info file_info;
#define LineNumber file_info.f_lineno
#define FileName file_info.f_filename
#define FileName file_info.f_fn
#define WorkingDir file_info.f_workingdir

24
lang/m2/m2mm/file_list.h
View file

@ -1,6 +1,22 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* F I L E L I S T S T R U C T U R E */
struct file_list {
char *a_filename;
char *a_dir;
struct idf *a_idf;
struct file_list *a_next;
char *a_filename; /* name of file */
char *a_dir; /* directory in which it resides */
struct idf *a_idf; /* its idf-structure */
struct file_list *a_next; /* next in list */
};
#define f_walk(list, ctrl) \
for (ctrl = (list); ctrl; ctrl = ctrl->a_next)
#define f_filename(a) ((a)->a_filename)
#define f_idf(a) ((a)->a_idf)
#define f_dir(a) ((a)->a_dir)

2
lang/m2/m2mm/lib.c
View file

@ -20,7 +20,7 @@ is_library_dir(d)
"system" definition modules. Return 1 if it is, 0 otherwise.
*/
return strcmp(lib_dir, d) == 0 ? 1 : 0;
return strcmp(lib_dir, d) == 0;
}
init_lib()

185
lang/m2/m2mm/main.c
View file

@ -117,13 +117,13 @@ Add(parglist, f, d, copy)
char *f, *d;
struct file_list **parglist;
{
register struct file_list *a = *parglist, *b = 0;
register struct file_list *a, *b = 0;
if (f == 0) return;
while (a && strcmp(a->a_filename, f) != 0) {
f_walk(*parglist, a) {
if (strcmp(f_filename(a), f) == 0) break;
b = a;
a = a->a_next;
}
if (a) return 0;
a = new_file_list();
@ -139,45 +139,55 @@ Add(parglist, f, d, copy)
return 1;
}
int
openfile(a)
register struct file_list *a;
{
char *fn;
register struct file_list *p, *prev = 0;
if (! InsertFile(f_filename(a), DEFPATH, &fn)) {
Gerror("Could not find %s", f_filename(a));
f_walk(arglist, p) {
if (p == a) {
if (! prev) arglist = p->a_next;
else prev->a_next = a->a_next;
break;
}
prev = p;
}
return 0;
}
FileName = fn;
LineNumber = 1;
a->a_dir = WorkingDir = getwdir(FileName);
return 1;
}
ProcessArgs()
{
register struct file_list *a = arglist;
char *fn;
register struct file_list *a;
while (a) {
register char *p = strrindex(a->a_filename, '.');
f_walk(arglist, a) {
register char *p = strrindex(f_filename(a), '.');
CurrentArg = a;
DEFPATH[0] = a->a_dir;
DEFPATH[0] = f_dir(a);
if ( p && strcmp(p, ".def") == 0) {
ForeignFlag = 0;
if (! InsertFile(a->a_filename, DEFPATH, &fn)) {
Gerror("Could not find %s", a->a_filename);
a->a_filename = "";
a = a->a_next;
if (! openfile(a)) {
continue;
}
FileName = fn;
a->a_dir = WorkingDir = getwdir(FileName);
DefModule();
}
else if (p && strcmp(p, ".mod") == 0) {
if (! InsertFile(a->a_filename, DEFPATH, &fn)) {
Gerror("Could not find %s", a->a_filename);
*p = 0;
a->a_filename = Salloc(a->a_filename,
strlen(a->a_filename) +
(unsigned)11);
strcat(a->a_filename, ".$(SUFFIX)");
a = a->a_next;
if (! openfile(a)) {
*p = 0; /* ??? */
continue;
}
FileName = fn;
a->a_dir = WorkingDir = getwdir(FileName);
CompUnit();
}
else fatal("No Modula-2 file: %s", a->a_filename);
a = a->a_next;
else fatal("No Modula-2 file: %s", f_filename(a));
}
}
@ -207,23 +217,25 @@ AddToList(name, ext)
find_dependencies()
{
register struct file_list *arg = arglist;
register struct file_list *arg;
print("\nall:\t");
while (arg) {
char *dotspot = strrindex(arg->a_filename, '.');
f_walk(arglist, arg) {
char *fn = f_filename(arg);
char *dotspot = strrindex(fn, '.');
if (dotspot && strcmp(dotspot, ".mod") == 0) {
register struct idf *id = arg->a_idf;
register struct idf *id = f_idf(arg);
if (id) {
if (id->id_type == PROGRAM) {
print("%s ", id->id_text);
*dotspot = 0;
print("%s ", fn);
*dotspot = '.';
}
file_dep(id);
}
}
arg = arg->a_next;
}
print("\n\n");
}
@ -243,11 +255,11 @@ file_dep(id)
register struct file_list *p;
file_dep(iid);
for (p = iid->id_ddependson; p; p = p->a_next) {
Add(&(id->id_ddependson), p->a_filename,
p->a_dir, 0);
Add(&(id->id_mdependson), p->a_filename,
p->a_dir, 0);
f_walk(iid->id_ddependson, p) {
Add(&(id->id_ddependson), f_filename(p),
f_dir(p), 0);
Add(&(id->id_mdependson), f_filename(p),
f_dir(p), 0);
}
}
}
@ -258,9 +270,9 @@ file_dep(id)
register struct file_list *p;
file_dep(iid);
for (p = iid->id_ddependson; p; p = p->a_next) {
Add(&(id->id_mdependson), p->a_filename,
p->a_dir, 0);
f_walk(iid->id_ddependson, p) {
Add(&(id->id_mdependson), f_filename(p),
f_dir(p), 0);
}
}
}
@ -271,18 +283,18 @@ object(arg)
register struct file_list *arg;
{
static char buf[512];
char *dotp = strrindex(arg->a_filename, '.');
char *dotp = strrindex(f_filename(arg), '.');
buf[0] = 0;
/*
if (strcmp(arg->a_dir, ".") != 0) {
strcpy(buf, arg->a_dir);
if (strcmp(f_dir(arg), ".") != 0) {
strcpy(buf, f_dir(arg));
strcat(buf, "/");
}
*/
*dotp = 0;
strcat(buf, arg->a_filename);
*dotp = '.';
if (dotp) *dotp = 0;
strcat(buf, f_filename(arg));
if (dotp) *dotp = '.';
strcat(buf, ".$(SUFFIX)");
return buf;
}
@ -290,21 +302,21 @@ object(arg)
pr_arg(a)
register struct file_list *a;
{
if (strcmp(a->a_dir, ".") == 0) {
print(a->a_filename);
if (strcmp(f_dir(a), ".") == 0) {
print(f_filename(a));
}
else print("%s/%s", a->a_dir, a->a_filename);
else print("%s/%s", f_dir(a), f_filename(a));
}
print_dep()
{
register struct file_list *arg = arglist;
register struct file_list *arg;
while (arg) {
char *dotspot = strrindex(arg->a_filename, '.');
f_walk(arglist, arg) {
char *dotspot = strrindex(f_filename(arg), '.');
if (dotspot && strcmp(dotspot, ".mod") == 0) {
register struct idf *id = arg->a_idf;
register struct idf *id = f_idf(arg);
if (id) {
char *obj = object(arg);
@ -312,39 +324,44 @@ print_dep()
print("%s: \\\n\t", obj);
pr_arg(arg);
for (a = id->id_mdependson; a; a = a->a_next) {
if (*(a->a_filename)) {
f_walk(id->id_mdependson, a) {
if (*(f_filename(a))) /* ??? */ {
print(" \\\n\t");
pr_arg(a);
}
}
print("\n\t$(MOD) -c $(M2FLAGS) $(IFLAGS) ");
print("\n\t$(MOD) -c.$(SUFFIX) $(M2FLAGS) $(IFLAGS) ");
pr_arg(arg);
print("\n");
}
}
arg = arg->a_next;
}
}
prog_dep(id)
prog_dep(id, a)
register struct idf *id;
struct file_list *a;
{
register struct lnk *m;
register struct file_list *p;
id->id_mdependson = 0;
id->id_def = 0;
if (strlen(id->id_text) >= 10) id->id_text[10] = 0;
Add(&(id->id_mdependson), id->id_text, id->id_dir, 0);
if (id->id_type == PROGRAM) {
Add(&(id->id_mdependson), f_filename(a), f_dir(a), 0);
}
else {
if (strlen(id->id_text) >= 10) id->id_text[10] = 0;
Add(&(id->id_mdependson), id->id_text, id->id_dir, 0);
}
for (m = id->id_modimports; m; m = m->lnk_next) {
register struct idf *iid = m->lnk_imp;
if (Add(&(id->id_mdependson), iid->id_text, iid->id_dir, 0)) {
if (iid->id_def) prog_dep(iid);
for (p = iid->id_mdependson; p; p = p->a_next) {
Add(&(id->id_mdependson), p->a_filename,
p->a_dir, 0);
f_walk(iid->id_mdependson, p) {
Add(&(id->id_mdependson), f_filename(p),
f_dir(p), 0);
}
}
}
@ -355,12 +372,12 @@ module_in_arglist(n)
{
register struct file_list *a;
for (a = arglist; a; a = a->a_next) {
char *dotp = strrindex(a->a_filename, '.');
f_walk(arglist, a) {
char *dotp = strrindex(f_filename(a), '.');
if (dotp && strcmp(dotp, ".mod") == 0) {
*dotp = 0;
if (strcmp(a->a_filename, n) == 0) {
if (strcmp(f_filename(a), n) == 0) {
*dotp = '.';
return 1;
}
@ -370,38 +387,48 @@ module_in_arglist(n)
return 0;
}
pr_prog_dep(id)
pr_prog_dep(id, a)
register struct idf *id;
struct file_list *a;
{
register struct file_list *p;
print("\nOBS_%s =", id->id_text);
for (p = id->id_mdependson; p; p = p->a_next) {
if (module_in_arglist(p->a_filename) || ! p->a_dir) {
print(" \\\n\t%s.$(SUFFIX)", p->a_filename);
f_walk(id->id_mdependson, p) {
if (module_in_arglist(f_filename(p)) || ! f_dir(p)) {
print(" \\\n\t%s", object(p));
}
else if (! is_library_dir(p->a_dir)) {
print(" \\\n\t%s/%s.$(SUFFIX)", p->a_dir, p->a_filename);
}
print("\n\nOBS2_%s =", id->id_text);
f_walk(id->id_mdependson, p) {
if (module_in_arglist(f_filename(p)) || ! f_dir(p)) {
/* nothing */
}
else if (! is_library_dir(f_dir(p))) {
print(" \\\n\t%s/%s", f_dir(p), object(p));
}
}
print("\n\n");
print("%s:\t$(OBS_%s)\n", id->id_text, id->id_text);
print("\t$(MOD) -.mod -o %s $(M2FLAGS) $(OBS_%s)\n", id->id_text, id->id_text);
print("o_files:\t$(OBS_%s)\n\n", id->id_text);
print("%s:\t$(OBS_%s) $(OBS2_%s)\n", id->id_text, id->id_text, id->id_text);
print("\t$(MOD) -.mod -o %s $(M2FLAGS) $(OBS_%s) $(OBS2_%s)\n", id->id_text, id->id_text, id->id_text);
}
programs()
{
register struct file_list *a;
for (a = arglist; a; a = a->a_next) {
char *dotspot = strrindex(a->a_filename, '.');
f_walk(arglist, a) {
char *dotspot = strrindex(f_filename(a), '.');
if (dotspot && strcmp(dotspot, ".mod") == 0) {
register struct idf *id = a->a_idf;
register struct idf *id = f_idf(a);
if (id && id->id_type == PROGRAM) {
prog_dep(id);
pr_prog_dep(id);
prog_dep(id, a);
/* *dotspot = 0; */
pr_prog_dep(id, a);
/* *dotspot = '.'; */
}
}
}

10
lang/m2/m2mm/options.c
View file

@ -59,15 +59,9 @@ AddInclDir(text)
}
if (++nDEF > mDEF) {
char **n = (char **)
Malloc((unsigned)((10+mDEF)*sizeof(char *)));
for (i = 0; i < mDEF; i++) {
n[i] = DEFPATH[i];
}
free((char *) DEFPATH);
DEFPATH = n;
mDEF += 10;
DEFPATH = (char **) Realloc((char *)DEFPATH,
(unsigned)(mDEF * sizeof(char *)));
}
i = ndirs++;

11
lang/m2/m2mm/program.g
View file

@ -51,19 +51,15 @@ new_lnk()
%start DefModule, DefinitionModule;
ModuleDeclaration :
MODULE IDENT
priority
';'
import((struct lnk **) 0)*
export?
block
IDENT
MODULE IDENT priority ';' import((struct lnk **) 0)* export?
block IDENT
;
priority:
[
'[' ConstExpression ']'
|
/* empty */
]
;
@ -72,6 +68,7 @@ export :
[
QUALIFIED
|
/* empty */
]
IdentList ';'
;