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 STATIC int
ex_error(nd, mess) ex_error(nd, mess)
t_node *nd; register t_node *nd;
char *mess; char *mess;
{ {
node_error(nd, "\"%s\": %s", symbol2str(nd->nd_symb), mess); node_error(nd, "\"%s\": %s", symbol2str(nd->nd_symb), mess);
@ -67,37 +67,37 @@ MkCoercion(pnd, tp)
register t_type *tp; register t_type *tp;
{ {
/* Make a coercion from the node indicated by *pnd to the /* 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_node *nd = *pnd;
register t_type *nd_tp = nd->nd_type; register t_type *nd_tp = nd->nd_type;
extern int pass_1; extern int pass_1;
int w = 0; char *wmess = 0;
if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return; if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return;
nd_tp = BaseType(nd_tp); nd_tp = BaseType(nd_tp);
if (nd->nd_class == Value && if (nd->nd_class == Value &&
nd_tp->tp_fund != T_REAL && nd_tp->tp_fund != T_REAL &&
tp->tp_fund != T_REAL) { tp->tp_fund != T_REAL) {
/* Constant expression mot involving REALs */
switch(tp->tp_fund) { switch(tp->tp_fund) {
case T_SUBRANGE: case T_SUBRANGE:
if (! chk_bounds(tp->sub_lb, nd->nd_INT, if (! chk_bounds(tp->sub_lb, nd->nd_INT,
BaseType(tp)->tp_fund) || BaseType(tp)->tp_fund) ||
! chk_bounds(nd->nd_INT, tp->sub_ub, ! chk_bounds(nd->nd_INT, tp->sub_ub,
BaseType(tp)->tp_fund)) { BaseType(tp)->tp_fund)) {
node_warning(nd, wmess = "range bound";
W_ORDINARY,
"might cause range bound error");
w = 1;
} }
break; break;
case T_ENUMERATION: case T_ENUMERATION:
case T_CHAR: case T_CHAR:
if (nd->nd_INT < 0 || nd->nd_INT >= tp->enm_ncst) { if (nd->nd_INT < 0 || nd->nd_INT >= tp->enm_ncst) {
node_warning(nd, wmess = "range bound";
W_ORDINARY,
"might cause range bound error");
w = 1;
} }
break; break;
case T_INTORCARD: case T_INTORCARD:
@ -105,10 +105,7 @@ MkCoercion(pnd, tp)
case T_POINTER: case T_POINTER:
if ((nd_tp->tp_fund == T_INTEGER && nd->nd_INT < 0) || if ((nd_tp->tp_fund == T_INTEGER && nd->nd_INT < 0) ||
(nd->nd_INT & ~full_mask[(int)(tp->tp_size)])) { (nd->nd_INT & ~full_mask[(int)(tp->tp_size)])) {
node_warning(nd, wmess = "conversion";
W_ORDINARY,
"might cause conversion error");
w = 1;
} }
break; break;
case T_INTEGER: { case T_INTEGER: {
@ -118,15 +115,15 @@ MkCoercion(pnd, tp)
if ((nd_tp->tp_fund == T_INTEGER && if ((nd_tp->tp_fund == T_INTEGER &&
j != i && j != 0) || j != i && j != 0) ||
(nd_tp->tp_fund != T_INTEGER && j)) { (nd_tp->tp_fund != T_INTEGER && j)) {
node_warning(nd, wmess = "conversion";
W_ORDINARY,
"might cause conversion error");
w = 1;
} }
} }
break; 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; nd->nd_type = tp;
return; return;
} }

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

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

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

@ -194,9 +194,9 @@ end_definition_list(pdf)
them again. them again.
Also, mark all other definitions "QUALIFIED EXPORT". 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_kind & D_IMPORTED) {
if (! (df->df_flags & D_USED)) { if (! (df->df_flags & D_USED)) {
warning(W_ORDINARY, "identifier \"%s\" imported but not used", df->df_idf->id_text); 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; df->df_flags |= D_QEXPORTED;
pdf = &(df->df_nextinscope); 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); if (!forwflag) FreeNode(FromId);
} }
EnterGlobalImportList(idlist) EnterImportList(idlist, local)
register t_node *idlist; register t_node *idlist;
{ {
/* Import "idlist" from the enclosing scope. /* 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(); extern t_def *GetDefinitionModule();
struct f_info f; struct f_info f;
f = file_info; f = file_info;
for (; idlist; idlist = idlist->nd_left) { 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; 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 ] [ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
{ *pnd = dot2node(Oper, *pnd, NULLNODE); } { *pnd = dot2node(Oper, *pnd, NULLNODE); }
SimpleExpression(&((*pnd)->nd_right)) SimpleExpression(&((*pnd)->nd_right))
]? |
]
; ;
/* Inline in expression /* Inline in expression
@ -121,7 +122,8 @@ SimpleExpression(t_node **pnd;)
{ nd = dot2leaf(Uoper); { nd = dot2leaf(Uoper);
/* priority of unary operator ??? */ /* priority of unary operator ??? */
} }
]? |
]
term(pnd) term(pnd)
{ if (nd) { { if (nd) {
nd->nd_right = *pnd; nd->nd_right = *pnd;
@ -170,11 +172,12 @@ factor(register t_node **p;)
} : } :
qualident(p) qualident(p)
[ [
designator_tail(p)? designator_tail(p)
[ [
{ *p = dot2node(Call, *p, NULLNODE); } { *p = dot2node(Call, *p, NULLNODE); }
ActualParameters(&((*p)->nd_right)) ActualParameters(&((*p)->nd_right))
]? |
]
| |
bare_set(&nd) bare_set(&nd)
{ nd->nd_left = *p; *p = nd; } { nd->nd_left = *p; *p = nd; }
@ -229,7 +232,8 @@ bare_set(t_node **pnd;)
[ { nd = nd->nd_right; } [ { nd = nd->nd_right; }
',' element(nd) ',' element(nd)
]* ]*
]? |
]
'}' '}'
; ;
@ -246,7 +250,8 @@ element(register t_node *nd;)
UPTO UPTO
{ nd1 = dot2node(Link, nd1, NULLNODE);} { nd1 = dot2node(Link, nd1, NULLNODE);}
expression(&(nd1->nd_right)) expression(&(nd1->nd_right))
]? |
]
{ nd->nd_right = dot2node(Link, nd1, NULLNODE); { nd->nd_right = dot2node(Link, nd1, NULLNODE);
nd->nd_right->nd_symb = ','; nd->nd_right->nd_symb = ',';
} }
@ -255,7 +260,7 @@ element(register t_node *nd;)
designator(t_node **pnd;) designator(t_node **pnd;)
: :
qualident(pnd) qualident(pnd)
designator_tail(pnd)? designator_tail(pnd)
; ;
designator_tail(t_node **pnd;): designator_tail(t_node **pnd;):
@ -266,6 +271,7 @@ designator_tail(t_node **pnd;):
| |
visible_designator_tail(pnd) visible_designator_tail(pnd)
]* ]*
|
; ;
visible_designator_tail(t_node **pnd;) visible_designator_tail(t_node **pnd;)

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

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

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

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