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

many minor corrections

Browse source
This commit is contained in:
ceriel 1987-05-18 15:57:33 +00:00
parent e0c3807b29
commit 946006fb08
15 changed files with 193 additions and 186 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -156,13 +156,6 @@ getch()
return ch;
}
STATIC
linedirective() {
/* Read a line directive
*/
register int ch;
}
CheckForLineDirective()
{
register int ch = getch();
@ -529,7 +522,7 @@ lexwarning(W_ORDINARY, "character constant out of range");
tk->TOK_REL = Salloc("0.0", 5);
lexerror("floating constant too long");
}
else tk->TOK_REL = Salloc(buf, np - buf) + 1;
else tk->TOK_REL = Salloc(buf, (unsigned) (np - buf)) + 1;
toktype = real_type;
return tk->tk_symb = REAL;

70
lang/m2/comp/Makefile
View file

@ -20,7 +20,7 @@ PROFILE =
CFLAGS = $(PROFILE) $(INCLUDES) -O -DSTATIC=
LINTFLAGS = -DSTATIC= -DNORCSID
MALLOC = $(LIBDIR)/malloc.o
LFLAGS = $(PROFILE)
LDFLAGS = -i $(PROFILE)
LSRC = tokenfile.c program.c declar.c expression.c statement.c
LOBJ = tokenfile.o program.o declar.o expression.o statement.o
CSRC = LLlex.c LLmessage.c error.c main.c \
@ -34,7 +34,7 @@ COBJ = LLlex.o LLmessage.o char.o error.o main.o \
cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \
code.o tmpvar.o lookup.o Version.o next.o
GENC= $(LSRC) symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c next.c
SRC = $(CSRC) $(GENC) Lpars.c
SRC = $(CSRC) $(GENC)
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENH= errout.h\
@ -137,10 +137,18 @@ depend:
#INCLINCLINCLINCL
Xlint:
lint $(INCLUDES) $(LINTFLAGS) $(SRC)
lint $(INCLUDES) $(LINTFLAGS) $(SRC) \
$(LIBDIR)/llib-lem_mes.ln \
$(LIBDIR)/llib-lemk.ln \
$(LIBDIR)/llib-linput.ln \
$(LIBDIR)/llib-lassert.ln \
$(LIBDIR)/llib-lalloc.ln \
$(LIBDIR)/llib-lprint.ln \
$(LIBDIR)/llib-lstring.ln \
$(LIBDIR)/llib-lsystem.ln
$(CURRDIR)/main: $(OBJ)
$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o $(CURRDIR)/main
$(CC) $(LDFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o $(CURRDIR)/main
size $(CURRDIR)/main
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
@ -162,7 +170,6 @@ LLlex.o: warning.h
LLmessage.o: LLlex.h
LLmessage.o: Lpars.h
LLmessage.o: idf.h
char.o: class.h
error.o: LLlex.h
error.o: debug.h
error.o: debugcst.h
@ -189,7 +196,6 @@ main.o: standards.h
main.o: tokenname.h
main.o: type.h
main.o: warning.h
symbol2str.o: Lpars.h
tokenname.o: Lpars.h
tokenname.o: idf.h
tokenname.o: tokenname.h
@ -223,14 +229,6 @@ def.o: main.h
def.o: node.h
def.o: scope.h
def.o: type.h
scope.o: LLlex.h
scope.o: debug.h
scope.o: debugcst.h
scope.o: def.h
scope.o: idf.h
scope.o: node.h
scope.o: scope.h
scope.o: type.h
misc.o: LLlex.h
misc.o: f_info.h
misc.o: idf.h
@ -316,15 +314,6 @@ walk.o: scope.h
walk.o: type.h
walk.o: walk.h
walk.o: warning.h
casestat.o: LLlex.h
casestat.o: Lpars.h
casestat.o: debug.h
casestat.o: debugcst.h
casestat.o: density.h
casestat.o: desig.h
casestat.o: node.h
casestat.o: type.h
casestat.o: walk.h
desig.o: LLlex.h
desig.o: debug.h
desig.o: debugcst.h
@ -344,12 +333,6 @@ code.o: scope.h
code.o: standards.h
code.o: type.h
code.o: walk.h
tmpvar.o: debug.h
tmpvar.o: debugcst.h
tmpvar.o: def.h
tmpvar.o: main.h
tmpvar.o: scope.h
tmpvar.o: type.h
lookup.o: LLlex.h
lookup.o: debug.h
lookup.o: debugcst.h
@ -359,8 +342,6 @@ lookup.o: misc.h
lookup.o: node.h
lookup.o: scope.h
lookup.o: type.h
next.o: debug.h
next.o: debugcst.h
tokenfile.o: Lpars.h
program.o: LLlex.h
program.o: Lpars.h
@ -405,4 +386,31 @@ statement.o: idf.h
statement.o: node.h
statement.o: scope.h
statement.o: type.h
symbol2str.o: Lpars.h
char.o: class.h
Lpars.o: Lpars.h
casestat.o: LLlex.h
casestat.o: Lpars.h
casestat.o: debug.h
casestat.o: debugcst.h
casestat.o: density.h
casestat.o: desig.h
casestat.o: node.h
casestat.o: type.h
casestat.o: walk.h
tmpvar.o: debug.h
tmpvar.o: debugcst.h
tmpvar.o: def.h
tmpvar.o: main.h
tmpvar.o: scope.h
tmpvar.o: type.h
scope.o: LLlex.h
scope.o: debug.h
scope.o: debugcst.h
scope.o: def.h
scope.o: idf.h
scope.o: node.h
scope.o: scope.h
scope.o: type.h
next.o: debug.h
next.o: debugcst.h

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

@ -33,6 +33,7 @@
#include "warning.h"
extern char *symbol2str();
extern char *sprint();
STATIC
Xerror(nd, mess, edf)
@ -293,7 +294,7 @@ ChkElement(expp, tp, set, level)
register struct node *expr = *expp;
register struct node *left = expr->nd_left;
register struct node *right = expr->nd_right;
register int i;
register arith i;
if (expr->nd_class == Link && expr->nd_symb == UPTO) {
/* { ... , expr1 .. expr2, ... }
@ -310,7 +311,7 @@ ChkElement(expp, tp, set, level)
*/
if (left->nd_INT > right->nd_INT) {
node_error(expp, "lower bound exceeds upper bound in range");
node_error(expr, "lower bound exceeds upper bound in range");
return 0;
}
@ -385,7 +386,7 @@ ChkSet(expp)
if (!is_type(df) ||
(df->df_type->tp_fund != T_SET)) {
if (df->df_kind != D_ERROR) {
Xerror(expp, "not a set type", df);
Xerror(nd, "not a set type", df);
}
return 0;
}
@ -571,6 +572,23 @@ ChkProcCall(expp)
return retval;
}
int
ChkFunCall(expp)
register struct node *expp;
{
/* Check a call that must have a result
*/
int retval = 1;
if (!ChkCall(expp)) retval = 0;
if (expp->nd_type == 0) {
node_error(expp, "function call expected");
expp->nd_type = error_type;
retval = 0;
}
return retval;
}
int
ChkCall(expp)
register struct node *expp;
@ -1007,7 +1025,7 @@ ChkStandard(expp, left)
tk->TOK_INT = PointedtoType(left->nd_type)->tp_size;
tk->tk_symb = INTEGER;
tk->tk_lineno = left->nd_lineno;
nd = MkLeaf(Value, &dt);
nd = MkLeaf(Value, tk);
nd->nd_type = card_type;
tk->tk_symb = ',';
arg->nd_right = MkNode(Link, nd, NULLNODE, tk);
@ -1199,7 +1217,7 @@ int (*ExprChkTable[])() = {
ChkBinOper,
ChkUnOper,
ChkArrow,
ChkCall,
ChkFunCall,
ChkExLinkOrName,
NodeCrash,
ChkSet,

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

@ -49,11 +49,9 @@ CodeConst(cst, size)
else {
crash("(CodeConst)");
/*
label dlab = ++data_label;
C_df_dlb(dlab);
C_df_dlb(++data_label);
C_rom_icon(long2str((long) cst), size);
C_lae_dlb(dlab, (arith) 0);
C_lae_dlb(data_label, (arith) 0);
C_loi(size);
*/
}
@ -63,14 +61,13 @@ CodeString(nd)
register struct node *nd;
{
if (nd->nd_type->tp_fund != T_STRING) {
/* Character constant */
C_loc(nd->nd_INT);
}
else {
label lab = ++data_label;
C_df_dlb(lab);
C_df_dlb(++data_label);
C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
C_lae_dlb(lab, (arith) 0);
C_lae_dlb(data_label, (arith) 0);
}
}
@ -100,11 +97,8 @@ CodeExpr(nd, ds, true_label, false_label)
case Oper:
CodeOper(nd, true_label, false_label);
if (true_label == 0) ds->dsg_kind = DSG_LOADED;
else {
ds->dsg_kind = DSG_INIT;
true_label = 0;
}
ds->dsg_kind = DSG_LOADED;
true_label = NO_LABEL;
break;
case Uoper:
@ -114,14 +108,11 @@ CodeExpr(nd, ds, true_label, false_label)
case Value:
switch(nd->nd_symb) {
case REAL: {
label lab = ++data_label;
C_df_dlb(lab);
case REAL:
C_df_dlb(++data_label);
C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
C_lae_dlb(lab, (arith) 0);
C_lae_dlb(data_label, (arith) 0);
C_loi(nd->nd_type->tp_size);
}
break;
case STRING:
CodeString(nd);
@ -142,16 +133,11 @@ CodeExpr(nd, ds, true_label, false_label)
case Xset:
case Set: {
register arith *st = nd->nd_set;
register int i;
register int i = tp->tp_size / word_size;
register arith *st = nd->nd_set + i;
st = nd->nd_set;
ds->dsg_kind = DSG_LOADED;
if (!st) {
C_zer(tp->tp_size);
break;
}
for (i = tp->tp_size / word_size, st += i; i > 0; i--) {
for (; i > 0; i--) {
C_loc(*--st);
}
CodeSet(nd);
@ -162,11 +148,10 @@ CodeExpr(nd, ds, true_label, false_label)
crash("(CodeExpr) bad node type");
}
if (true_label != 0) {
if (true_label != NO_LABEL) {
/* Only for boolean expressions
*/
CodeValue(ds, tp->tp_size, tp->tp_align);
*ds = InitDesig;
C_zne(true_label);
C_bra(false_label);
}
@ -304,10 +289,10 @@ CodeCall(nd)
register struct def *df = left->nd_def;
if (df->df_kind == D_PROCEDURE) {
arith level = df->df_scope->sc_level;
int level = df->df_scope->sc_level;
if (level > 0) {
C_lxl((arith) proclevel - level);
C_lxl((arith) (proclevel - level));
}
C_cal(NameOfProc(df));
break;
@ -321,7 +306,7 @@ CodeCall(nd)
CodePExpr(left);
C_cai();
}
if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar);
C_asp(left->nd_type->prc_nbpar);
if (result_tp = ResultType(left->nd_type)) {
if (IsConstructed(result_tp)) {
C_lfr(pointer_size);
@ -353,7 +338,7 @@ CodeParameters(param, arg)
C_loc(tp->arr_elsize);
if (IsConformantArray(left_type)) {
DoHIGH(left);
DoHIGH(left->nd_def);
if (elem->tp_size != left_type->arr_elem->tp_size) {
/* This can only happen if the formal type is
ARRAY OF (WORD|BYTE)
@ -478,13 +463,13 @@ CodeStd(nd)
case S_HIGH:
assert(IsConformantArray(tp));
DoHIGH(left);
DoHIGH(left->nd_def);
break;
case S_SIZE:
case S_TSIZE:
assert(IsConformantArray(tp));
DoHIGH(left);
DoHIGH(left->nd_def);
C_inc();
C_loc(tp->arr_elem->tp_size);
C_mlu(word_size);
@ -777,7 +762,7 @@ CodeOper(expr, true_label, false_label)
default:
crash("bad type COMPARE");
}
if (true_label != 0) {
if (true_label != NO_LABEL) {
compare(expr->nd_symb, true_label);
C_bra(false_label);
}
@ -794,7 +779,7 @@ CodeOper(expr, true_label, false_label)
CodePExpr(leftop);
CodeCoercion(leftop->nd_type, word_type);
C_inn(rightop->nd_type->tp_size);
if (true_label != 0) {
if (true_label != NO_LABEL) {
C_zne(true_label);
C_bra(false_label);
}
@ -806,7 +791,7 @@ CodeOper(expr, true_label, false_label)
struct desig Des;
int genlabels = 0;
if (true_label == 0) {
if (true_label == NO_LABEL) {
genlabels = 1;
true_label = ++text_label;
false_label = ++text_label;
@ -1000,17 +985,15 @@ CodeDStore(nd)
CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align);
}
DoHIGH(nd)
struct node *nd;
DoHIGH(df)
register struct def *df;
{
/* Get the high index of a conformant array, indicated by "nd".
The high index is the second field in the descriptor of
the array, so it is easily found.
*/
register struct def *df = nd->nd_def;
register arith highoff;
assert(nd->nd_class == Def);
assert(df->df_kind == D_VARIABLE);
assert(IsConformantArray(df->df_type));

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

@ -132,7 +132,7 @@ TypeDeclaration
{
struct def *df;
struct type *tp;
struct node *nd;
register struct node *nd;
}:
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE);
nd = MkLeaf(Name, &dot);
@ -143,7 +143,7 @@ TypeDeclaration
}
;
type(struct type **ptp;):
type(register struct type **ptp;):
%default SimpleType(ptp)
|
ArrayType(ptp)
@ -157,7 +157,7 @@ type(struct type **ptp;):
ProcedureType(ptp)
;
SimpleType(struct type **ptp;)
SimpleType(register struct type **ptp;)
{
struct type *tp;
} :
@ -264,9 +264,9 @@ FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
FieldList(struct scope *scope; arith *cnt; int *palign;)
{
struct node *FldList;
register struct idf *id = 0;
struct type *tp;
struct node *nd;
register struct def *df;
arith tcnt, max;
} :
[
@ -288,7 +288,17 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
{ if (nd->nd_class != Name) {
error("illegal variant tag");
}
else id = nd->nd_IDF;
else {
df = define(nd->nd_IDF, scope, D_FIELD);
*palign = lcm(*palign, tp->tp_align);
if (!(tp->tp_fund & T_DISCRETE)) {
error("illegal type in variant");
}
df->df_type = tp;
df->fld_off = align(*cnt, tp->tp_align);
*cnt = df->fld_off + tp->tp_size;
df->df_flags |= D_QEXPORTED;
}
FreeNode(nd);
}
| /* Old fashioned! the first qualident now represents
@ -302,22 +312,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
| ':' qualtype(&tp)
/* Aha, third edition. Well done! */
]
{
*palign = lcm(*palign, tp->tp_align);
if (id) {
register struct def *df =
define(id, scope, D_FIELD);
if (!(tp->tp_fund & T_DISCRETE)) {
error("illegal type in variant");
}
df->df_type = tp;
df->fld_off = align(*cnt, tp->tp_align);
*cnt = df->fld_off + tp->tp_size;
df->df_flags |= D_QEXPORTED;
}
tcnt = *cnt;
}
{ tcnt = *cnt; }
OF variant(scope, &tcnt, tp, palign)
{ max = tcnt; tcnt = *cnt; }
[
@ -360,26 +355,26 @@ CaseLabelList(struct type **ptp; struct node **pnd;):
CaseLabels(struct type **ptp; register struct node **pnd;)
{
register struct node *nd1;
register struct node *nd;
}:
ConstExpression(pnd)
{ nd1 = *pnd; }
{ nd = *pnd; }
[
UPTO { *pnd = MkNode(Link,nd1,NULLNODE,&dot); }
UPTO { *pnd = MkNode(Link,nd,NULLNODE,&dot); }
ConstExpression(&(*pnd)->nd_right)
{ if (!TstCompat(nd1->nd_type,
{ if (!TstCompat(nd->nd_type,
(*pnd)->nd_right->nd_type)) {
node_error((*pnd)->nd_right,
"type incompatibility in case label");
nd1->nd_type = error_type;
nd->nd_type = error_type;
}
}
]?
{ if (*ptp != 0 && !TstCompat(*ptp, nd1->nd_type)) {
node_error(nd1,
{ if (*ptp != 0 && !TstCompat(*ptp, nd->nd_type)) {
node_error(nd,
"type incompatibility in case label");
}
*ptp = nd1->nd_type;
*ptp = nd->nd_type;
}
;
@ -392,7 +387,7 @@ SetType(struct type **ptp;) :
have to be declared yet, so be careful about identifying
type-identifiers
*/
PointerType(struct type **ptp;) :
PointerType(register struct type **ptp;) :
POINTER TO
[ %if (type_or_forward(ptp))
type(&((*ptp)->next))
@ -409,7 +404,7 @@ qualtype(struct type **ptp;)
{ *ptp = qualified_type(nd); }
;
ProcedureType(struct type **ptp;)
ProcedureType(register struct type **ptp;)
{
struct paramlist *pr = 0;
arith parmaddr = 0;
@ -423,18 +418,12 @@ ProcedureType(struct type **ptp;)
{ *ptp = proc_type(*ptp, pr, parmaddr); }
;
FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;)
{
struct type *tp;
int VARp;
} :
FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
'('
[
var(&VARp) FormalType(&tp)
{ EnterParamList(ppr,NULLNODE,tp,VARp,parmaddr); }
VarFormalType(ppr, parmaddr)
[
',' var(&VARp) FormalType(&tp)
{ EnterParamList(ppr,NULLNODE,tp,VARp,parmaddr); }
',' VarFormalType(ppr, parmaddr)
]*
]?
')'
@ -442,10 +431,22 @@ FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;)
]?
;
var(int *VARp;):
VAR { *VARp = D_VARPAR; }
|
/* empty */ { *VARp = D_VALPAR; }
VarFormalType(struct paramlist **ppr; arith *parmaddr;)
{
struct type *tp;
int isvar;
} :
var(&isvar)
FormalType(&tp)
{ EnterParamList(ppr,NULLNODE,tp,isvar,parmaddr); }
;
var(int *VARp;) :
[
VAR { *VARp = D_VARPAR; }
|
/* empty */ { *VARp = D_VALPAR; }
]
;
ConstantDeclaration

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

@ -36,7 +36,7 @@ struct idf *DefId;
STATIC char *
getwdir(fn)
char *fn;
register char *fn;
{
register char *p;
char *strrindex();
@ -49,7 +49,7 @@ getwdir(fn)
if (p) {
*p = '\0';
fn = Salloc(fn, p - &fn[0] + 1);
fn = Salloc(fn, (unsigned) (p - &fn[0] + 1));
*p = '/';
return fn;
}
@ -64,7 +64,7 @@ GetFile(name)
in the directories mentioned in "DEFPATH".
*/
char buf[15];
char *strcpy(), *strcat();
char *strncpy(), *strcat();
static char *WorkingDir = ".";
strncpy(buf, name, 10);

18
lang/m2/comp/desig.c
View file

@ -67,7 +67,6 @@ CodeValue(ds, size, al)
/* Generate code to load the value of the designator described
in "ds"
*/
arith tmp = 0;
switch(ds->dsg_kind) {
case DSG_LOADED:
@ -100,14 +99,16 @@ CodeValue(ds, size, al)
break;
}
if (ds->dsg_kind == DSG_PLOADED) {
tmp = NewPtr();
C_stl(tmp);
arith sz = WA(size) - pointer_size;
C_asp(-sz);
C_lor((arith) 1);
C_adp(sz);
C_loi(pointer_size);
}
C_asp(-WA(size));
if (!tmp) CodeAddress(ds);
else {
C_lol(tmp);
FreePtr(tmp);
else {
C_asp(-WA(size));
CodeAddress(ds);
}
C_loc(size);
C_cal("_load");
@ -300,6 +301,7 @@ CodeMove(rhs, left, rtp)
}
{
arith tmp;
extern arith NewPtr();
if (loadedflag) {
tmp = NewPtr();

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

@ -14,6 +14,7 @@
#include <system.h>
#include <em_arith.h>
#include <em_label.h>
#include <alloc.h>
#include "input.h"
#include "f_info.h"
@ -101,7 +102,7 @@ Compile(src, dst)
C_ms_emx(word_size, pointer_size);
CheckForLineDirective();
CompUnit();
C_ms_src((arith) (LineNumber - 1), FileName);
C_ms_src((int)LineNumber - 1, FileName);
if (!err_occurred) {
C_exp(Defined->mod_vis->sc_scope->sc_name);
WalkModule(Defined);

3
lang/m2/comp/options.c
View file

@ -13,6 +13,7 @@
#include <em_arith.h>
#include <em_label.h>
#include <alloc.h>
#include "type.h"
#include "main.h"
@ -117,7 +118,7 @@ DoOption(text)
if (++nDEF > mDEF) {
char **n = (char **)
Malloc((10+mDEF)*sizeof(char *));
Malloc((unsigned)((10+mDEF)*sizeof(char *)));
for (i = 0; i < mDEF; i++) {
n[i] = DEFPATH[i];

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

@ -66,10 +66,7 @@ ModuleDeclaration
}
;
priority(register struct def *df;)
{
register struct node *nd;
} :
priority(register struct def *df;):
[
'[' ConstExpression(&(df->mod_priority)) ']'
{ if (!(df->mod_priority->nd_type->tp_fund &

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

@ -60,7 +60,7 @@ open_and_close_scope(scopetype)
open_scope(scopetype);
sc = CurrentScope;
close_scope();
close_scope(0);
return sc;
}
@ -106,7 +106,7 @@ chk_proc(df)
STATIC
chk_forw(pdf)
register struct def **pdf;
struct def **pdf;
{
/* Called at scope close. Look for all forward definitions and
if the scope was a closed scope, give an error message for
@ -197,6 +197,7 @@ Reverse(pdf)
}
close_scope(flag)
register int flag;
{
/* Close a scope. If "flag" is set, check for forward declarations,
either POINTER declarations, or EXPORTs, or forward references

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

@ -20,6 +20,7 @@
Also, the "token2str.c" file is produced from this file.
*/
#ifdef ___XXX___
struct tokenname tkspec[] = { /* the names of the special tokens */
{IDENT, "identifier"},
{STRING, "string"},
@ -35,6 +36,7 @@ struct tokenname tkcomp[] = { /* names of the composite tokens */
{BECOMES, ":="},
{0, ""}
};
#endif
struct tokenname tkidf[] = { /* names of the identifier tokens */
{AND, "AND"},
@ -80,6 +82,7 @@ struct tokenname tkidf[] = { /* names of the identifier tokens */
{0, ""}
};
#ifdef ___XXX___
struct tokenname tkinternal[] = { /* internal keywords */
{PROGRAM, ""},
{0, "0"}
@ -88,6 +91,7 @@ struct tokenname tkinternal[] = { /* internal keywords */
struct tokenname tkstandard[] = { /* standard identifiers */
{0, ""}
};
#endif
/* Some routines to handle tokennames */

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

@ -12,7 +12,7 @@
struct paramlist { /* structure for parameterlist of a PROCEDURE */
struct paramlist *next;
struct def *par_def; /* "df" of parameter */
#define IsVarParam(xpar) ((xpar)->par_def->df_flags & D_VARPAR)
#define IsVarParam(xpar) ((int) ((xpar)->par_def->df_flags & D_VARPAR))
#define TypeOfParam(xpar) ((xpar)->par_def->df_type)
};

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

@ -217,7 +217,7 @@ u_small(tp, n)
tp->tp_size = 1;
tp->tp_align = 1;
}
else if (ufit(n, short_size)) {
else if (ufit(n, (int)short_size)) {
tp->tp_size = short_size;
tp->tp_align = short_align;
}
@ -302,16 +302,18 @@ chk_basesubrange(tp, base)
struct type *
subr_type(lb, ub)
struct node *lb, *ub;
register struct node *lb;
struct node *ub;
{
/* Construct a subrange type from the constant expressions
indicated by "lb" and "ub", but first perform some
checks
*/
register struct type *tp = BaseType(lb->nd_type), *res;
register struct type *tp = BaseType(lb->nd_type);
register struct type *res;
if (!TstCompat(lb->nd_type, ub->nd_type)) {
node_error(ub, "types of subrange bounds not equal");
node_error(lb, "types of subrange bounds not equal");
return error_type;
}
@ -326,14 +328,14 @@ subr_type(lb, ub)
/* Check base type
*/
if (! (tp->tp_fund & T_DISCRETE)) {
node_error(ub, "illegal base type for subrange");
node_error(lb, "illegal base type for subrange");
return error_type;
}
/* Check bounds
*/
if (lb->nd_INT > ub->nd_INT) {
node_error(ub, "lower bound exceeds upper bound");
node_error(lb, "lower bound exceeds upper bound");
}
/* Now construct resulting type
@ -351,8 +353,8 @@ subr_type(lb, ub)
res->tp_size = 1;
res->tp_align = 1;
}
else if (fit(res->sub_lb, short_size) &&
fit(res->sub_ub, short_size)) {
else if (fit(res->sub_lb, (int)short_size) &&
fit(res->sub_ub, (int)short_size)) {
res->tp_size = short_size;
res->tp_align = short_align;
}
@ -381,22 +383,19 @@ genrck(tp)
*/
arith lb, ub;
register label ol;
int newlabel = 0;
getbounds(tp, &lb, &ub);
if (tp->tp_fund == T_SUBRANGE) {
if (!(ol = tp->sub_rck)) {
tp->sub_rck = ol = ++data_label;
newlabel = 1;
tp->sub_rck = ++data_label;
}
}
else if (!(ol = tp->enm_rck)) {
tp->enm_rck = ol = ++data_label;
newlabel = 1;
tp->enm_rck = ++data_label;
}
if (newlabel) {
C_df_dlb(ol);
if (!ol) {
C_df_dlb(ol = data_label);
C_rom_cst(lb);
C_rom_cst(ub);
}
@ -571,18 +570,21 @@ int
type_or_forward(ptp)
struct type **ptp;
{
struct node *nd = 0;
/* POINTER TO IDENTIFIER construction. The IDENTIFIER resides
in "dot". This routine handles the different cases.
*/
register struct node *nd;
*ptp = construct_type(T_POINTER, NULLTYPE);
if (lookup(dot.TOK_IDF, CurrentScope, 1)
if (lookup(dot.TOK_IDF, CurrentScope, 1)) {
/* Either a Module or a Type, but in both cases defined
in this scope, so this is the correct identification
*/
||
( nd = new_node(),
nd->nd_token = dot,
lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
)
return 1;
}
nd = new_node();
nd->nd_token = dot;
if (lookfor(nd, CurrVis, 0)->df_kind == D_MODULE) {
/* A Modulename in one of the enclosing scopes.
It is not clear from the language definition that
it is correct to handle these like this, but
@ -591,8 +593,7 @@ type_or_forward(ptp)
one token.
???
*/
) {
if (nd) free_node(nd);
free_node(nd);
return 1;
}
/* Enter a forward reference into a list belonging to the
@ -652,7 +653,7 @@ DumpType(tp)
switch(tp->tp_fund) {
case T_RECORD:
print("RECORD\n");
DumpScope(tp->rec_scope);
DumpScope(tp->rec_scope->sc_def);
break;
case T_ENUMERATION:
print("ENUMERATION; ncst:%d", tp->enm_ncst); break;

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

@ -75,15 +75,14 @@ DoProfil()
static label filename_label = 0;
if (! options['L']) {
register label fn_label = filename_label;
if (!fn_label) {
filename_label = fn_label = ++data_label;
C_df_dlb(fn_label);
if (!filename_label) {
filename_label = ++data_label;
C_df_dlb(filename_label);
C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
}
C_fil_dlb(fn_label, (arith) 0);
C_fil_dlb(filename_label, (arith) 0);
}
}
@ -126,16 +125,14 @@ WalkModule(module)
/* We don't actually prevent recursive calls,
but do nothing if called recursively
*/
label l1 = ++data_label;
C_df_dlb(l1);
C_bss_cst(word_size, (arith) 0, 1);
C_df_dlb(++data_label);
C_con_cst((arith) 0);
/* if this one is set to non-zero, the initialization
was already done.
*/
C_loe_dlb(l1, (arith) 0);
C_loe_dlb(data_label, (arith) 0);
C_zne(RETURN_LABEL);
C_ine_dlb(l1, (arith) 0);
C_ine_dlb(data_label, (arith) 0);
}
for (; nd; nd = nd->next) {