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

made to fit on a PDP-11 again

Browse source
This commit is contained in:
ceriel 1988-02-10 14:06:34 +00:00
parent 78de25b639
commit d7d501d43a
8 changed files with 127 additions and 125 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lang/m2/comp/Version.c
View file

@ -1 +1 @@
static char Version[] = "ACK Modula-2 compiler Version 0.33";
static char Version[] = "ACK Modula-2 compiler Version 0.34";

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

@ -55,7 +55,7 @@ df_error(nd, mess, edf)
STATIC int
ex_error(nd, mess)
t_node *nd;
register t_node *nd;
char *mess;
{
node_error(nd, "\"%s\": %s", symbol2str(nd->nd_symb), mess);
@ -67,37 +67,37 @@ MkCoercion(pnd, tp)
register t_type *tp;
{
/* Make a coercion from the node indicated by *pnd to the
type indicated by tp.
type indicated by tp. If the node indicated by *pnd
is constant, try to do the coercion compile-time.
Coercions are inserted in the tree when
- the expression is not constant or
- we are in the second pass and the coercion might cause
an error
*/
register t_node *nd = *pnd;
register t_type *nd_tp = nd->nd_type;
extern int pass_1;
int w = 0;
char *wmess = 0;
if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return;
nd_tp = BaseType(nd_tp);
if (nd->nd_class == Value &&
nd_tp->tp_fund != T_REAL &&
tp->tp_fund != T_REAL) {
/* Constant expression mot involving REALs */
switch(tp->tp_fund) {
case T_SUBRANGE:
if (! chk_bounds(tp->sub_lb, nd->nd_INT,
BaseType(tp)->tp_fund) ||
! chk_bounds(nd->nd_INT, tp->sub_ub,
BaseType(tp)->tp_fund)) {
node_warning(nd,
W_ORDINARY,
"might cause range bound error");
w = 1;
wmess = "range bound";
}
break;
case T_ENUMERATION:
case T_CHAR:
if (nd->nd_INT < 0 || nd->nd_INT >= tp->enm_ncst) {
node_warning(nd,
W_ORDINARY,
"might cause range bound error");
w = 1;
wmess = "range bound";
}
break;
case T_INTORCARD:
@ -105,10 +105,7 @@ MkCoercion(pnd, tp)
case T_POINTER:
if ((nd_tp->tp_fund == T_INTEGER && nd->nd_INT < 0) ||
(nd->nd_INT & ~full_mask[(int)(tp->tp_size)])) {
node_warning(nd,
W_ORDINARY,
"might cause conversion error");
w = 1;
wmess = "conversion";
}
break;
case T_INTEGER: {
@ -118,15 +115,15 @@ MkCoercion(pnd, tp)
if ((nd_tp->tp_fund == T_INTEGER &&
j != i && j != 0) ||
(nd_tp->tp_fund != T_INTEGER && j)) {
node_warning(nd,
W_ORDINARY,
"might cause conversion error");
w = 1;
wmess = "conversion";
}
}
break;
}
if (!w || pass_1) {
if (wmess) {
node_warning(nd, W_ORDINARY, "might cause %s error", wmess);
}
if (!wmess || pass_1) {
nd->nd_type = tp;
return;
}

33
lang/m2/comp/declar.g
View file

@ -68,11 +68,14 @@ ProcedureHeading(t_def **pdf; int type;)
[
';' FPSection(&pr, &parmaddr)
]*
]?
|
]
')'
[ ':' qualtype(&tp)
]?
]?
|
]
|
]
{ CheckWithDef(*pdf, proc_type(tp, pr, parmaddr));
#ifndef NOSTRICT
if (tp && IsConstructed(tp)) {
@ -128,10 +131,12 @@ declaration
* [
* ';' FPSection(ppr, parmaddr)
* ]*
* ]?
* |
* ]
* ')'
* [ ':' qualtype(ptp)
* ]?
* |
* ]
* ;
*/
@ -362,10 +367,12 @@ FieldList(t_scope *scope; arith *cnt; int *palign;)
]*
[ ELSE FieldListSequence(scope, &tcnt, palign)
{ if (tcnt > max) max = tcnt; }
]?
|
]
END
{ *cnt = max; }
]?
|
]
;
variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
@ -381,7 +388,8 @@ variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
FreeNode(nd);
}
':' FieldListSequence(scope, cnt, palign)
]?
|
]
/* Changed rule in new modula-2 */
;
@ -426,7 +434,8 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
}
}
]?
|
]
{
*ptp = nd->nd_type;
}
@ -482,7 +491,8 @@ FormalTypeList(t_type **ptp;)
[
',' VarFormalType(&pr, &parmaddr)
]*
]?
|
]
')'
[ ':' qualtype(ptp)
| { *ptp = 0; }
@ -547,6 +557,7 @@ IdentAddr(t_node **pnd;)
[ '['
ConstExpression(&(nd->nd_left))
']'
]?
|
]
{ *pnd = nd; }
;

5
lang/m2/comp/def.c
View file

@ -194,9 +194,9 @@ end_definition_list(pdf)
them again.
Also, mark all other definitions "QUALIFIED EXPORT".
*/
register t_def *df = *pdf;
register t_def *df;
while (df) {
while (df = *pdf) {
if (df->df_kind & D_IMPORTED) {
if (! (df->df_flags & D_USED)) {
warning(W_ORDINARY, "identifier \"%s\" imported but not used", df->df_idf->id_text);
@ -209,7 +209,6 @@ end_definition_list(pdf)
df->df_flags |= D_QEXPORTED;
pdf = &(df->df_nextinscope);
}
df = *pdf;
}
}

23
lang/m2/comp/enter.c
View file

@ -479,31 +479,24 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
if (!forwflag) FreeNode(FromId);
}
EnterGlobalImportList(idlist)
EnterImportList(idlist, local)
register t_node *idlist;
{
/* Import "idlist" from the enclosing scope.
Definition modules must be read for "idlist".
If the import is not local, definition modules must be read
for "idlist".
*/
t_scope *sc = enclosing(CurrVis)->sc_scope;
extern t_def *GetDefinitionModule();
struct f_info f;
f = file_info;
for (; idlist; idlist = idlist->nd_left) {
DoImport(GetDefinitionModule(idlist->nd_IDF, 1), CurrentScope);
DoImport(local ?
ForwDef(idlist, sc) :
GetDefinitionModule(idlist->nd_IDF, 1),
CurrentScope);
file_info = f;
}
}
EnterImportList(idlist)
register t_node *idlist;
{
/* Import "idlist" from the enclosing scope.
*/
t_scope *sc = enclosing(CurrVis)->sc_scope;
for (; idlist; idlist = idlist->nd_left) {
DoImport(ForwDef(idlist, sc), CurrentScope);
}
}

20
lang/m2/comp/expression.g
View file

@ -103,7 +103,8 @@ expression(t_node **pnd;)
[ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
{ *pnd = dot2node(Oper, *pnd, NULLNODE); }
SimpleExpression(&((*pnd)->nd_right))
]?
|
]
;
/* Inline in expression
@ -121,7 +122,8 @@ SimpleExpression(t_node **pnd;)
{ nd = dot2leaf(Uoper);
/* priority of unary operator ??? */
}
]?
|
]
term(pnd)
{ if (nd) {
nd->nd_right = *pnd;
@ -170,11 +172,12 @@ factor(register t_node **p;)
} :
qualident(p)
[
designator_tail(p)?
designator_tail(p)
[
{ *p = dot2node(Call, *p, NULLNODE); }
ActualParameters(&((*p)->nd_right))
]?
|
]
|
bare_set(&nd)
{ nd->nd_left = *p; *p = nd; }
@ -229,7 +232,8 @@ bare_set(t_node **pnd;)
[ { nd = nd->nd_right; }
',' element(nd)
]*
]?
|
]
'}'
;
@ -246,7 +250,8 @@ element(register t_node *nd;)
UPTO
{ nd1 = dot2node(Link, nd1, NULLNODE);}
expression(&(nd1->nd_right))
]?
|
]
{ nd->nd_right = dot2node(Link, nd1, NULLNODE);
nd->nd_right->nd_symb = ',';
}
@ -255,7 +260,7 @@ element(register t_node *nd;)
designator(t_node **pnd;)
:
qualident(pnd)
designator_tail(pnd)?
designator_tail(pnd)
;
designator_tail(t_node **pnd;):
@ -266,6 +271,7 @@ designator_tail(t_node **pnd;):
|
visible_designator_tail(pnd)
]*
|
;
visible_designator_tail(t_node **pnd;)

123
lang/m2/comp/program.g
View file

@ -49,55 +49,53 @@
ModuleDeclaration
{
register t_def *df;
t_node *exportlist = 0;
int qualified;
register t_def *df;
t_node *exportlist;
int qualified;
} :
MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); }
priority(df)
priority(&(df->mod_priority))
';'
import(1)*
export(&qualified, &exportlist)?
export(&qualified, &exportlist)
block(&(df->mod_body))
IDENT { if (exportlist) {
EnterExportList(exportlist, qualified);
}
IDENT { EnterExportList(exportlist, qualified);
close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
match_id(df->df_idf, dot.TOK_IDF);
}
;
priority(register t_def *df;):
priority(register t_node **prio;):
[
'[' ConstExpression(&(df->mod_priority)) ']'
{ if (!(df->mod_priority->nd_type->tp_fund &
T_CARDINAL)) {
node_error(df->mod_priority,
"illegal priority");
'[' ConstExpression(prio) ']'
{ if (! ((*prio)->nd_type->tp_fund & T_CARDINAL)) {
node_error(*prio, "illegal priority");
}
}
|
{ df->mod_priority = 0; }
]
;
export(int *QUALflag; t_node **ExportList;):
EXPORT
{ *ExportList = 0; *QUALflag = D_EXPORTED; }
[
QUALIFIED
{ *QUALflag = D_QEXPORTED; }
EXPORT
[
QUALIFIED
{ *QUALflag = D_QEXPORTED; }
|
]
IdentList(ExportList) ';'
|
{ *QUALflag = D_EXPORTED; }
]
IdentList(ExportList) ';'
;
import(int local;)
{
t_node *ImportList;
register t_node *FromId = 0;
register t_def *df;
extern t_def *GetDefinitionModule();
t_node *ImportList;
register t_node *FromId = 0;
register t_def *df;
extern t_def *GetDefinitionModule();
} :
[ FROM
IDENT { FromId = dot2leaf(Name);
@ -106,7 +104,8 @@ import(int local;)
}
else df = GetDefinitionModule(dot.TOK_IDF, 1);
}
]?
|
]
IMPORT IdentList(&ImportList) ';'
/*
When parsing a global module, this is the place where we must
@ -117,57 +116,54 @@ import(int local;)
{ if (FromId) {
EnterFromImportList(ImportList, df, FromId);
}
else if (local) EnterImportList(ImportList);
else EnterGlobalImportList(ImportList);
else EnterImportList(ImportList, local);
FreeNode(ImportList);
}
;
DefinitionModule
{
register t_def *df;
t_node *exportlist;
int dummy;
extern t_idf *DefId;
extern int ForeignFlag;
register t_def *df;
t_node *exportlist;
int dummy;
extern t_idf *DefId;
extern int ForeignFlag;
register t_scope *currscope = CurrentScope;
} :
DEFINITION
MODULE IDENT { df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
df->df_flags |= D_BUSY;
df->df_flags |= ForeignFlag;
df->df_flags |= D_BUSY | ForeignFlag;
if (!Defined) Defined = df;
CurrentScope->sc_definedby = df;
currscope->sc_definedby = df;
if (DefId && df->df_idf != DefId) {
error("DEFINITION MODULE name is \"%s\", not \"%s\"",
df->df_idf->id_text, DefId->id_text);
}
CurrentScope->sc_name = df->df_idf->id_text;
currscope->sc_name = df->df_idf->id_text;
df->mod_vis = CurrVis;
df->df_type = standard_type(T_RECORD, 1, (arith) 1);
df->df_type->rec_scope = df->mod_vis->sc_scope;
df->df_type->rec_scope = currscope;
DefinitionModule++;
}
';'
import(0)*
[
export(&dummy, &exportlist)
export(&dummy, &exportlist)
/* New Modula-2 does not have export lists in definition
modules. Issue a warning.
*/
{
if (exportlist) {
#ifndef STRICT_3RD_ED
if (! options['3'])
if (! options['3'])
node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignored");
else
else
#endif
error("export list not allowed in definition module");
FreeNode(exportlist);
FreeNode(exportlist);
}
}
|
/* empty */
]
definition* END IDENT
{ end_definition_list(&(CurrentScope->sc_def));
{ end_definition_list(&(currscope->sc_def));
DefinitionModule--;
match_id(df->df_idf, dot.TOK_IDF);
df->df_flags &= ~D_BUSY;
@ -177,8 +173,8 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
definition
{
register t_def *df;
t_def *dummy;
register t_def *df;
t_def *dummy;
} :
CONST [ %persistent ConstantDeclaration ';' ]*
|
@ -201,14 +197,13 @@ definition
|
VAR [ %persistent VariableDeclaration ';' ]*
|
ProcedureHeading(&dummy, D_PROCHEAD)
';'
ProcedureHeading(&dummy, D_PROCHEAD) ';'
;
ProgramModule
{
extern t_def *GetDefinitionModule();
register t_def *df;
extern t_def *GetDefinitionModule();
register t_def *df;
} :
MODULE
IDENT { if (state == IMPLEMENTATION) {
@ -223,7 +218,7 @@ ProgramModule
CurrentScope->sc_definedby = df;
}
}
priority(df)
priority(&(df->mod_priority))
';' import(0)*
block(&(df->mod_body)) IDENT
{ close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
@ -232,22 +227,20 @@ ProgramModule
'.'
;
Module:
{ error("Compiling a definition module");
open_scope(CLOSEDSCOPE);
state = DEFINITION;
}
CompilationUnit:
{ error("Compiling a definition module");
open_scope(CLOSEDSCOPE);
state = DEFINITION;
}
DefinitionModule
{ close_scope(SC_CHKFORW); }
{ close_scope(SC_CHKFORW); }
| %default
[
IMPLEMENTATION { state = IMPLEMENTATION; }
IMPLEMENTATION
{ state = IMPLEMENTATION; }
|
/* empty */ { state = PROGRAM; }
/* empty */
{ state = PROGRAM; }
]
ProgramModule
;
CompilationUnit:
Module
;

9
lang/m2/comp/statement.g
View file

@ -166,7 +166,8 @@ IfStatement(t_node **pnd;)
[
ELSE
StatementSequence(&(nd->nd_right))
]?
|
]
END
;
@ -186,7 +187,8 @@ CaseStatement(t_node **pnd;)
{ nd = nd->nd_right; }
]*
[ ELSE StatementSequence(&(nd->nd_right))
]?
|
]
END
;
@ -194,7 +196,8 @@ case(t_node **pnd; t_type **ptp;) :
[ CaseLabelList(ptp, pnd)
':' { *pnd = dot2node(Link, *pnd, NULLNODE); }
StatementSequence(&((*pnd)->nd_right))
]?
|
]
{ *pnd = dot2node(Link, *pnd, NULLNODE);
(*pnd)->nd_symb = '|';
}