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)) { if (is_hex(ch)) {
state = Hex; state = Hex;
} }
else state = End; else {
ch = 'D';
state = End;
PushBack();
}
break; break;
case Hex: case Hex:

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

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

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

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

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

@ -11,11 +11,11 @@
struct f_info { struct f_info {
unsigned short f_lineno; unsigned short f_lineno;
char *f_filename; char *f_fn;
char *f_workingdir; char *f_workingdir;
}; };
extern struct f_info file_info; extern struct f_info file_info;
#define LineNumber file_info.f_lineno #define LineNumber file_info.f_lineno
#define FileName file_info.f_filename #define FileName file_info.f_fn
#define WorkingDir file_info.f_workingdir #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 { struct file_list {
char *a_filename; char *a_filename; /* name of file */
char *a_dir; char *a_dir; /* directory in which it resides */
struct idf *a_idf; struct idf *a_idf; /* its idf-structure */
struct file_list *a_next; 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. "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() init_lib()

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

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

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

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