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

too many changes: some cosmetic; some for 2/4; some for added options

Browse source
This commit is contained in:
ceriel 1988-03-21 16:36:31 +00:00
parent 6a51fac1e4
commit 759f4738ca
5 changed files with 108 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -50,7 +50,7 @@ SkipComment()
/* Skip Modula-2 comments (* ... *).
Note that comments may be nested (par. 3.5).
*/
register int ch;
register int ch, c;
register int CommentLevel = 0;
LoadChar(ch);
@ -66,17 +66,23 @@ SkipComment()
*/
ForeignFlag = D_FOREIGN;
break;
case 'R':
/* Range checks, on or off */
LoadChar(ch);
if (ch == '-') {
options['R'] = 1;
case 'U':
inidf['_'] = 1;
break;
case 'A': /* Extra array bound checks, on or off */
case 'R': /* Range checks, on or off */
{
int on_on_minus = ch == 'R';
LoadChar(c);
if (c == '-') {
options[ch] = on_on_minus;
break;
}
if (ch == '+') {
options['R'] = 0;
if (c == '+') {
options[ch] = !on_on_minus;
break;
}
}
/* fall through */
default:
PushBack();
@ -365,6 +371,9 @@ again:
}
else {
tk->tk_data.tk_str = str;
if (! fit(str->s_length, (int) word_size)) {
lexerror("string too long");
}
toktype = standard_type(T_STRING, 1, str->s_length);
}
return tk->tk_symb = STRING;
@ -504,11 +513,11 @@ lexwarning(W_ORDINARY, "overflow in constant");
toktype = longint_type;
}
else if (sgnswtch == 0 &&
tk->TOK_INT<=max_int[(int)word_size]) {
tk->TOK_INT<=max_int[(int)int_size]) {
toktype = intorcard_type;
}
else if (! chk_bounds(tk->TOK_INT,
full_mask[(int)word_size],
full_mask[(int)int_size],
T_CARDINAL)) {
lexwarning(W_ORDINARY, "overflow in constant");
}

11
lang/m2/comp/Makefile
View file

@ -1,8 +1,9 @@
# make modula-2 "compiler"
EMHOME = ../../..
MHDIR = $(EMHOME)/modules/h
PKGDIR = $(EMHOME)/modules/pkg
LIBDIR = $(EMHOME)/modules/lib
EMHOME = ../../..
MDIR = $(EMHOME)/modules
MHDIR = $(MDIR)/h
PKGDIR = $(MDIR)/pkg
LIBDIR = $(MDIR)/lib
OBJECTCODE = $(LIBDIR)/libemk.a
LLGEN = $(EMHOME)/bin/LLgen
MKDEP = $(EMHOME)/bin/mkdep
@ -325,10 +326,12 @@ chk_expr.o: strict3rd.h
chk_expr.o: target_sizes.h
chk_expr.o: type.h
chk_expr.o: warning.h
options.o: class.h
options.o: idfsize.h
options.o: main.h
options.o: nocross.h
options.o: nostrict.h
options.o: squeeze.h
options.o: strict3rd.h
options.o: target_sizes.h
options.o: type.h

33
lang/m2/comp/Parameters
View file

@ -23,26 +23,25 @@
#define MAXSIZE 8 /* the maximum of the SZ_* constants */
/* target machine sizes */
#define SZ_CHAR (arith)1
#define SZ_SHORT (arith)2
#define SZ_WORD (arith)4
#define SZ_INT (arith)4
#define SZ_LONG (arith)4
#define SZ_FLOAT (arith)4
#define SZ_DOUBLE (arith)8
#define SZ_POINTER (arith)4
#define SZ_CHAR ((arith)1)
#define SZ_SHORT ((arith)2)
#define SZ_WORD ((arith)4)
#define SZ_INT ((arith)4)
#define SZ_LONG ((arith)4)
#define SZ_FLOAT ((arith)4)
#define SZ_DOUBLE ((arith)8)
#define SZ_POINTER ((arith)4)
/* target machine alignment requirements */
#define AL_CHAR 1
#define AL_SHORT (int)SZ_SHORT
#define AL_WORD (int)SZ_WORD
#define AL_INT (int)SZ_WORD
#define AL_LONG (int)SZ_WORD
#define AL_FLOAT (int)SZ_WORD
#define AL_DOUBLE (int)SZ_WORD
#define AL_POINTER (int)SZ_WORD
#define AL_STRUCT 1
#define AL_UNION 1
#define AL_SHORT ((int)SZ_SHORT)
#define AL_WORD ((int)SZ_WORD)
#define AL_INT ((int)SZ_WORD)
#define AL_LONG ((int)SZ_WORD)
#define AL_FLOAT ((int)SZ_WORD)
#define AL_DOUBLE ((int)SZ_WORD)
#define AL_POINTER ((int)SZ_WORD)
#define AL_STRUCT ((int)SZ_WORD)
!File: debugcst.h

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

@ -73,7 +73,8 @@ compact(nr, low, up)
*/
arith diff = up - low;
return (nr == 0 || (diff >= 0 && diff / nr <= (DENSITY - 1)));
return (nr != 0 && diff >= 0 && fit(diff, (int) word_size) &&
diff / nr <= (DENSITY - 1));
}
CaseCode(nd, exitlabel)
@ -149,11 +150,10 @@ CaseCode(nd, exitlabel)
if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
/* CSA
*/
C_rom_cst(sh->sh_lowerbd);
C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
ce = sh->sh_entries;
if (sh->sh_nrofentries)
for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
C_rom_cst((arith) 0);
C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
assert(ce);
if (val == ce->ce_value) {
C_rom_ilb(ce->ce_label);
@ -162,6 +162,8 @@ CaseCode(nd, exitlabel)
else if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon("0", pointer_size);
}
C_loc(sh->sh_lowerbd);
C_sbu(word_size);
c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csa(word_size);
}

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

@ -282,9 +282,9 @@ ChkLinkOrName(expp, flags)
/* Fields of a record are always D_QEXPORTED,
so ...
*/
df_error(expp,
if (df_error(expp,
"not exported from qualifying module",
df);
df)) assert(0);
}
if (!(left->nd_class == Def &&
@ -617,7 +617,7 @@ ChkProcCall(expp)
/* Just check parameters as if they were value parameters
*/
while (expp->nd_right) {
getarg(&expp, 0, 0, edf);
if (getarg(&expp, 0, 0, edf)) { }
}
return 0;
}
@ -646,9 +646,11 @@ ChkProcCall(expp)
}
if (expp->nd_right) {
df_error(expp->nd_right, "too many parameters supplied", edf);
if (df_error(expp->nd_right,"too many parameters supplied",edf)){
assert(0);
}
while (expp->nd_right) {
getarg(&expp, 0, 0, edf);
if (getarg(&expp, 0, 0, edf)) { }
}
return 0;
}
@ -779,20 +781,47 @@ AllowedTypes(operator)
}
STATIC int
ChkAddress(tpl, tpr)
ChkAddressOper(tpl, tpr, expp)
register t_type *tpl, *tpr;
register t_node *expp;
{
/* Check that either "tpl" or "tpr" are both of type
address_type, or that one of them is, but the other is
of type cardinal.
of a cardinal type.
Also insert proper coercions, making sure that the EM pointer
arithmetic instructions can be generated whenever possible
*/
if (tpr == address_type && expp->nd_symb == '+') {
/* use the fact that '+' is a commutative operator */
t_type *tmptype = tpr;
t_node *tmpnode = expp->nd_right;
tpr = tpl;
expp->nd_right = expp->nd_left;
tpl = tmptype;
expp->nd_left = tmpnode;
}
if (tpl == address_type) {
return tpr == address_type || (tpr->tp_fund & T_CARDINAL);
expp->nd_type = address_type;
if (tpr == address_type) {
return 1;
}
if (tpr->tp_fund & T_CARDINAL) {
MkCoercion(&(expp->nd_right),
expp->nd_symb=='+' || expp->nd_symb=='-' ?
tpr :
address_type);
return 1;
}
return 0;
}
if (tpr == address_type) {
return (tpl->tp_fund & T_CARDINAL);
if (tpr == address_type && tpl->tp_fund & T_CARDINAL) {
expp->nd_type = address_type;
MkCoercion(&(expp->nd_left), address_type);
return 1;
}
return 0;
@ -804,13 +833,13 @@ ChkBinOper(expp)
{
/* Check a binary operation.
*/
register t_node *left, *right;
register t_node *left = expp->nd_left, *right = expp->nd_right;
register t_type *tpl, *tpr;
t_type *result_type;
int allowed;
int retval;
left = expp->nd_left;
right = expp->nd_right;
/* First, check BOTH operands */
retval = ChkExpression(left) & ChkExpression(right);
@ -828,7 +857,7 @@ ChkBinOper(expp)
}
}
expp->nd_type = ResultOfOperation(expp->nd_symb, tpr);
expp->nd_type = result_type = ResultOfOperation(expp->nd_symb, tpr);
/* Check that the application of the operator is allowed on the type
of the operands.
@ -866,27 +895,26 @@ ChkBinOper(expp)
if (!(tpr->tp_fund & allowed) || !(tpl->tp_fund & allowed)) {
if (!((T_CARDINAL & allowed) &&
ChkAddress(tpl, tpr))) {
ChkAddressOper(tpl, tpr, expp))) {
return ex_error(expp, "illegal operand type(s)");
}
if (expp->nd_type->tp_fund & T_CARDINAL) {
expp->nd_type = address_type;
if (result_type == bool_type) expp->nd_type = bool_type;
}
else {
if (Boolean(expp->nd_symb) && tpl != bool_type) {
return ex_error(expp, "illegal operand type(s)");
}
}
if (Boolean(expp->nd_symb) && tpl != bool_type) {
return ex_error(expp, "illegal operand type(s)");
}
/* Operands must be compatible (distilled from Def 8.2)
*/
if (!TstCompat(tpr, tpl)) {
return ex_error(expp, "incompatible operand types");
}
/* Operands must be compatible (distilled from Def 8.2)
*/
if (!TstCompat(tpr, tpl)) {
return ex_error(expp, "incompatible operand types");
MkCoercion(&(expp->nd_left), tpl);
MkCoercion(&(expp->nd_right), tpr);
}
MkCoercion(&(expp->nd_left), tpl);
MkCoercion(&(expp->nd_right), tpr);
if (tpl->tp_fund == T_SET) {
if (left->nd_class == Set && right->nd_class == Set) {
cstset(expp);
@ -1071,7 +1099,9 @@ ChkStandard(expp)
MkCoercion(&(arg->nd_left), d2);
}
else {
df_error(left, "unexpected parameter type", edf);
if (df_error(left, "unexpected parameter type", edf)) {
assert(0);
}
break;
}
free_it = 1;