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

some minor bug fixes

Browse source
This commit is contained in:
ceriel 1986-12-01 10:06:53 +00:00
parent ad40a77afd
commit c57d4ff268
15 changed files with 165 additions and 106 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
lang/m2/comp/LLlex.c
View file

@ -411,8 +411,20 @@ again1:
/* Fall through */
case End:
*np++ = '\0';
tk->TOK_INT = str2long(&buf[1], base);
*np = '\0';
if (np >= &buf[NUMSIZE]) {
tk->TOK_INT = 1;
lexerror("constant too long");
}
else {
np = &buf[1];
while (*np == '0') np++;
tk->TOK_INT = str2long(np, base);
if (strlen(np) > 14 /* ??? */ ||
tk->TOK_INT < 0) {
lexwarning(W_ORDINARY, "overflow in constant");
}
}
if (ch == 'C' && base == 8) {
toktype = char_type;
if (tk->TOK_INT<0 || tk->TOK_INT>255) {

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

@ -16,28 +16,17 @@
extern char *symbol2str();
extern struct idf *gen_anon_idf();
extern int err_occurred;
LLmessage(tk)
int tk;
register int tk;
{
if (tk > 0) {
/* if (tk > 0), it represents the token to be inserted.
*/
error("%s missing", symbol2str(tk));
insert_token(tk);
}
else if (tk < 0) {
error("garbage at end of program");
}
else error("%s deleted", symbol2str(dot.tk_symb));
}
insert_token(tk)
int tk;
{
register struct token *dotp = &dot;
error("%s missing", symbol2str(tk));
aside = *dotp;
dotp->tk_symb = tk;
@ -61,3 +50,9 @@ insert_token(tk)
break;
}
}
else if (tk < 0) {
error("garbage at end of program");
}
else error("%s deleted", symbol2str(dot.tk_symb));
}

4
lang/m2/comp/Makefile
View file

@ -141,8 +141,8 @@ type.o: LLlex.h const.h debug.h debugcst.h def.h idf.h maxset.h node.h scope.h t
def.o: LLlex.h Lpars.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
scope.o: LLlex.h debug.h debugcst.h def.h idf.h node.h scope.h type.h
misc.o: LLlex.h f_info.h idf.h misc.h node.h
enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h node.h scope.h type.h
enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h
defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h misc.h node.h scope.h type.h
typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h
node.o: LLlex.h debug.h debugcst.h def.h node.h type.h
cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h

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

@ -994,23 +994,24 @@ ChkStandard(expp, left)
/* Now, make it look like a call to ALLOCATE or DEALLOCATE */
{
struct token dt;
register struct token *tk = &dt;
struct node *nd;
dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
dt.tk_symb = INTEGER;
dt.tk_lineno = left->nd_lineno;
tk->TOK_INT = PointedtoType(left->nd_type)->tp_size;
tk->tk_symb = INTEGER;
tk->tk_lineno = left->nd_lineno;
nd = MkLeaf(Value, &dt);
nd->nd_type = card_type;
dt.tk_symb = ',';
arg->nd_right = MkNode(Link, nd, NULLNODE, &dt);
tk->tk_symb = ',';
arg->nd_right = MkNode(Link, nd, NULLNODE, tk);
/* Ignore other arguments to NEW and/or DISPOSE ??? */
FreeNode(expp->nd_left);
dt.tk_symb = IDENT;
dt.tk_lineno = expp->nd_left->nd_lineno;
dt.TOK_IDF = str2idf(std == S_NEW ?
tk->tk_symb = IDENT;
tk->tk_lineno = expp->nd_left->nd_lineno;
tk->TOK_IDF = str2idf(std == S_NEW ?
"ALLOCATE" : "DEALLOCATE", 0);
expp->nd_left = MkLeaf(Name, &dt);
expp->nd_left = MkLeaf(Name, tk);
}
return ChkCall(expp);
@ -1145,7 +1146,7 @@ ChkCast(expp, left)
}
TryToString(nd, tp)
struct node *nd;
register struct node *nd;
struct type *tp;
{
/* Try a coercion from character constant to string.

29
lang/m2/comp/code.c
View file

@ -401,16 +401,7 @@ CodeParameters(param, arg)
return;
}
if (left_type->tp_fund == T_STRING) {
register arith szarg = WA(left_type->tp_size);
arith sz = WA(tp->tp_size);
if (szarg != sz) {
/* null padding required */
assert(szarg < sz);
C_zer(sz - szarg);
}
CodeString(left); /* push address of string */
C_loi(szarg);
CodePString(left, tp);
return;
}
CodePExpr(left);
@ -418,6 +409,22 @@ CodeParameters(param, arg)
CodeCoercion(left_type, tp);
}
CodePString(nd, tp)
struct node *nd;
struct type *tp;
{
arith szarg = WA(nd->nd_type->tp_size);
register arith zersz = WA(tp->tp_size) - szarg;
if (zersz) {
/* null padding required */
assert(zersz > 0);
C_zer(zersz);
}
CodeString(nd); /* push address of string */
C_loi(szarg);
}
CodeStd(nd)
struct node *nd;
{
@ -731,8 +738,8 @@ CodeOper(expr, true_label, false_label)
C_cmi(tp->tp_size);
break;
case T_POINTER:
case T_EQUAL:
case T_HIDDEN:
case T_EQUAL:
case T_CARDINAL:
case T_INTORCARD:
C_cmu(tp->tp_size);

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

@ -116,10 +116,15 @@ TypeDeclaration
{
struct def *df;
struct type *tp;
struct node *nd;
}:
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE);
nd = MkLeaf(Name, &dot);
}
'=' type(&tp)
{ DeclareType(df, tp); }
{ DeclareType(nd, df, tp);
free_node(nd);
}
;
type(struct type **ptp;):
@ -239,7 +244,11 @@ RecordType(struct type **ptp;)
close_scope(0);
}
FieldListSequence(scope, &size, &xalign)
{ *ptp = standard_type(T_RECORD, xalign, size);
{ if (size == 0) {
warning(W_ORDINARY, "empty record declaration");
size = 1;
}
*ptp = standard_type(T_RECORD, xalign, size);
(*ptp)->rec_scope = scope;
}
END

2
lang/m2/comp/def.H
View file

@ -1,7 +1,7 @@
/* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */
struct module {
arith mo_priority; /* priority of a module */
struct node *mo_priority;/* priority of a module */
struct scopelist *mo_vis;/* scope of this module */
struct node *mo_body; /* body of this module */
#define mod_priority df_value.df_module.mo_priority

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

@ -15,6 +15,7 @@
#include "LLlex.h"
#include "node.h"
#include "main.h"
#include "misc.h"
struct def *
Enter(name, kind, type, pnam)
@ -351,14 +352,8 @@ EnterExportList(Idlist, qualified)
}
if (df1->df_kind == D_HIDDEN &&
df->df_kind == D_TYPE) {
if (df->df_type->tp_fund != T_POINTER) {
node_error(idlist,
"opaque type \"%s\" is not a pointer type",
df->df_idf->id_text);
}
assert(df1->df_type->next == NULLTYPE);
DeclareType(idlist, df1, df->df_type);
df1->df_kind = D_TYPE;
df1->df_type->next = df->df_type;
continue;
}
}
@ -379,6 +374,7 @@ EnterFromImportList(Idlist, FromDef, FromId)
register struct node *idlist = Idlist;
register struct scopelist *vis;
register struct def *df;
char *module_name = FromDef->df_idf->id_text;
int forwflag = 0;
switch(FromDef->df_kind) {
@ -399,27 +395,31 @@ EnterFromImportList(Idlist, FromDef, FromId)
case D_MODULE:
vis = FromDef->mod_vis;
if (vis == CurrVis) {
node_error(FromId, "cannot import from current module \"%s\"",
FromDef->df_idf->id_text);
node_error(FromId, "cannot import from current module \"%s\"", module_name);
return;
}
break;
default:
node_error(FromId, "identifier \"%s\" does not represent a module",
FromDef->df_idf->id_text);
node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
return;
}
for (; idlist; idlist = idlist->next) {
if (forwflag) df = ForwDef(idlist, vis->sc_scope);
else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope, 1))) {
not_declared("identifier", idlist, " in qualifying module");
if (! is_anon_idf(idlist->nd_IDF)) {
node_error(idlist,
"identifier \"%s\" not declared in module \"%s\"",
idlist->nd_IDF->id_text,
module_name);
}
df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR);
}
else if (! (df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
node_error(idlist,
"identifier \"%s\" not exported from qualifying module",
idlist->nd_IDF->id_text);
"identifier \"%s\" not exported from module \"%s\"",
idlist->nd_IDF->id_text,
module_name);
df->df_flags |= D_QEXPORTED;
}
DoImport(df, CurrentScope);

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

@ -81,15 +81,15 @@ Compile(src, dst)
return 1;
}
#endif DEBUG
open_scope(CLOSEDSCOPE);
GlobalScope = CurrentScope;
open_scope(OPENSCOPE);
GlobalVis = CurrVis;
close_scope(0);
C_init(word_size, pointer_size);
if (! C_open(dst)) fatal("could not open output file");
C_magic();
C_ms_emx(word_size, pointer_size);
CompUnit();
C_ms_src((arith) (LineNumber - 1), FileName);
close_scope(SC_REVERSE);
if (!err_occurred) {
C_exp(Defined->mod_vis->sc_scope->sc_name);
WalkModule(Defined);

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

@ -44,7 +44,7 @@ ModuleDeclaration
int qualified;
} :
MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); }
priority(&(df->mod_priority))?
priority(df)
';'
import(1)*
export(&qualified, &exportlist)?
@ -57,19 +57,21 @@ ModuleDeclaration
}
;
priority(arith *pprio;)
priority(register struct def *df;)
{
register struct node *nd;
struct node *nd1; /* &nd is illegal */
} :
'[' ConstExpression(&nd1) ']'
{ nd = nd1;
if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
node_error(nd, "illegal priority");
[
'[' ConstExpression(&(df->mod_priority)) ']'
{ if (!(df->mod_priority->nd_type->tp_fund &
T_CARDINAL)) {
node_error(df->mod_priority,
"illegal priority");
}
*pprio = nd->nd_INT;
FreeNode(nd);
}
|
{ df->mod_priority = 0; }
]
;
export(int *QUALflag; struct node **ExportList;):
@ -121,7 +123,7 @@ DefinitionModule
if (!Defined) Defined = df;
CurrentScope->sc_name = df->df_idf->id_text;
df->mod_vis = CurrVis;
df->df_type = standard_type(T_RECORD, 1, (arith) 0);
df->df_type = standard_type(T_RECORD, 1, (arith) 1);
df->df_type->rec_scope = df->mod_vis->sc_scope;
DefinitionModule++;
}
@ -194,14 +196,14 @@ ProgramModule
RemoveImports(&(CurrentScope->sc_def));
}
else {
Defined = df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
Defined = df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = "_M2M";
}
CurrentScope->sc_definedby = df;
}
priority(&(df->mod_priority))?
priority(df)
';' import(0)*
block(&(df->mod_body)) IDENT
{ close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);

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

@ -14,8 +14,8 @@
#include "def.h"
#include "node.h"
struct scope *PervasiveScope, *GlobalScope;
struct scopelist *CurrVis;
struct scope *PervasiveScope;
struct scopelist *CurrVis, *GlobalVis;
extern int proclevel;
static struct scopelist *PervVis;
extern char options[];
@ -85,9 +85,14 @@ chk_proc(df)
{
/* Called at scope closing. Check all definitions, and if one
is a D_PROCHEAD, the procedure was not defined.
Also check that hidden types are defined.
*/
while (df) {
if (df->df_kind == D_PROCHEAD) {
if (df->df_kind == D_HIDDEN) {
error("hidden type \"%s\" not declared",
df->df_idf->id_text);
}
else if (df->df_kind == D_PROCHEAD) {
/* A not defined procedure
*/
error("procedure \"%s\" not defined",
@ -121,6 +126,7 @@ node_error(df1->df_forw_node, "\"%s\" is not a type", df1->df_idf->id_text);
df1->df_forw_type->next = df->df_type;
FreeNode(df1->df_forw_node);
free_def(df1);
continue;
}
else if (df->df_kind == D_FTYPE) {
df->df_kind = D_TYPE;

6
lang/m2/comp/scope.h
View file

@ -30,13 +30,13 @@ struct scopelist {
};
extern struct scope
*PervasiveScope,
*GlobalScope;
*PervasiveScope;
extern struct scopelist
*CurrVis;
*CurrVis, *GlobalVis;
#define CurrentScope (CurrVis->sc_scope)
#define GlobalScope (GlobalVis->sc_scope)
#define enclosing(x) ((x)->sc_encl)
#define scopeclosed(x) ((x)->sc_scopeclosed)
#define nextvisible(x) ((x)->next) /* use with scopelists */

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

@ -14,7 +14,7 @@
struct tokenname tkspec[] = { /* the names of the special tokens */
{IDENT, "identifier"},
{STRING, "string"},
{INTEGER, "integer"},
{INTEGER, "number"},
{REAL, "real"},
{0, ""}
};

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

@ -473,9 +473,10 @@ FreeType(tp)
free_type(tp);
}
DeclareType(df, tp)
DeclareType(nd, df, tp)
register struct def *df;
register struct type *tp;
struct node *nd;
{
/* A type with type-description "tp" is declared and must
be bound to definition "df".
@ -486,7 +487,9 @@ DeclareType(df, tp)
if (df->df_type && df->df_type->tp_fund == T_HIDDEN) {
if (! (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) {
error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
node_error(nd,
"opaque type \"%s\" is not a pointer type",
df->df_idf->id_text);
}
df->df_type->next = tp;
df->df_type->tp_fund = T_EQUAL;
@ -495,7 +498,9 @@ error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
if (tp == df->df_type) {
/* Circular definition! */
error("opaque type \"%s\" has a circular definition", df->df_idf->id_text);
node_error(nd,
"opaque type \"%s\" has a circular definition",
df->df_idf->id_text);
}
}
else df->df_type = tp;

34
lang/m2/comp/walk.c
View file

@ -34,10 +34,29 @@ label data_label;
static struct type *func_type;
struct withdesig *WithDesigs;
struct node *Modules;
static struct node *priority;
#define NO_EXIT_LABEL ((label) 0)
#define RETURN_LABEL ((label) 1)
STATIC
DoPriority()
{
if (priority) {
C_loc(priority->nd_INT);
C_cal("_stackprio");
C_asp(word_size);
}
}
STATIC
EndPriority()
{
if (priority) {
C_cal("_unstackprio");
}
}
STATIC
DoProfil()
{
@ -67,6 +86,7 @@ WalkModule(module)
struct scopelist *savevis = CurrVis;
CurrVis = module->mod_vis;
priority = module->mod_priority;
sc = CurrentScope;
/* Walk through it's local definitions
@ -81,6 +101,7 @@ WalkModule(module)
text_label = 1; /* label at end of initialization routine */
TmpOpen(sc); /* Initialize for temporaries */
C_pro_narg(sc->sc_name);
DoPriority();
DoProfil();
if (module == Defined) {
/* Body of implementation or program module.
@ -113,6 +134,7 @@ WalkModule(module)
DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
WalkNode(module->mod_body, NO_EXIT_LABEL);
C_df_ilb(RETURN_LABEL);
EndPriority();
C_ret((arith) 0);
C_end(-sc->sc_off);
proclevel--;
@ -146,6 +168,7 @@ WalkProcedure(procedure)
/* Generate code for this procedure
*/
C_pro_narg(sc->sc_name);
DoPriority();
DoProfil();
TmpOpen(sc);
@ -277,6 +300,7 @@ WalkProcedure(procedure)
C_ass(word_size);
}
C_lae_dlb(func_res_label, (arith) 0);
EndPriority();
C_ret(pointer_size);
}
else if (tp) {
@ -292,6 +316,7 @@ WalkProcedure(procedure)
C_lal(retsav);
C_loi(func_res_size);
}
EndPriority();
C_ret(func_res_size);
}
else {
@ -299,6 +324,7 @@ WalkProcedure(procedure)
C_lol(StackAdjustment);
C_ass(word_size);
}
EndPriority();
C_ret((arith) 0);
}
if (StackAdjustment) FreeInt(StackAdjustment);
@ -324,7 +350,7 @@ WalkDef(df)
WalkProcedure(df);
break;
case D_VARIABLE:
if (!proclevel) {
if (!proclevel && !df->var_addrgiven) {
C_df_dnam(df->var_name);
C_bss_cst(
WA(df->df_type->tp_size),
@ -554,11 +580,7 @@ node_error(right, "type incompatibility in RETURN statement");
break;
}
if (right->nd_type->tp_fund == T_STRING) {
arith strsize = WA(right->nd_type->tp_size);
C_zer(WA(func_type->tp_size) - strsize);
CodePExpr(right);
C_loi(strsize);
CodePString(right, func_type);
}
else CodePExpr(right);
}