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

Added LONGCARD as a local extension

Browse source
This commit is contained in:
ceriel 1996-08-14 07:42:40 +00:00
parent 1592c3638c
commit efacd02ffd
9 changed files with 59 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -529,6 +529,23 @@ lexwarning(W_ORDINARY, "character constant out of range");
return tk->tk_symb = INTEGER;
}
if (ch == 'D' && base == 10) {
if (options['l']) {
/* Local extension: LONGCARD exists,
so internally also longintorcard_type
exists.
*/
toktype = longcard_type;
if (ovfl == 0 && tk->TOK_INT >= 0 &&
tk->TOK_INT<=max_int[(int)long_size]) {
toktype = longintorcard_type;
}
else if (! chk_bounds(tk->TOK_INT,
full_mask[(int)long_size],
T_CARDINAL)) {
ovfl = 1;
}
}
else {
if (ovfl != 0 ||
tk->TOK_INT > max_int[(int)long_size] ||
tk->TOK_INT < 0) {
@ -536,6 +553,7 @@ lexwarning(W_ORDINARY, "character constant out of range");
}
toktype = longint_type;
}
}
else if (ovfl == 0 && tk->TOK_INT >= 0 &&
tk->TOK_INT<=max_int[(int)int_size]) {
toktype = intorcard_type;

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

@ -921,10 +921,10 @@ ChkBinOper(expp)
tpr = BaseType(exp->nd_RIGHT->nd_type);
if (intorcard(tpl, tpr) != 0) {
if (tpl == intorcard_type) {
if (tpl->tp_fund == T_INTORCARD) {
exp->nd_LEFT->nd_type = tpl = tpr;
}
if (tpr == intorcard_type) {
if (tpr->tp_fund == T_INTORCARD) {
exp->nd_RIGHT->nd_type = tpr = tpl;
}
}
@ -1052,6 +1052,9 @@ ChkUnOper(expp)
if (tpr == intorcard_type) {
exp->nd_type = int_type;
}
else if (tpr == longintorcard_type) {
exp->nd_type = longint_type;
}
if (right->nd_class == Value) {
cstunary(expp);
}
@ -1166,7 +1169,7 @@ ChkStandard(expp)
case S_SHORT:
case S_LONG: {
t_type *tp;
t_type *s1, *s2, *d1, *d2;
t_type *s1, *s2, *s3, *d1, *d2, *d3;
if (!(arg = getarg(&arglink, 0, 0, edf))) {
return 0;
@ -1178,12 +1181,16 @@ ChkStandard(expp)
d1 = int_type;
s2 = longreal_type;
d2 = real_type;
s3 = longcard_type;
d3 = card_type;
}
else {
d1 = longint_type;
s1 = int_type;
d2 = longreal_type;
s2 = real_type;
d3 = longcard_type;
s3 = card_type;
}
if (tp == s1) {
@ -1192,6 +1199,9 @@ ChkStandard(expp)
else if (tp == s2) {
MkCoercion(&(arglink->nd_LEFT), d2);
}
else if (options['l'] && tp == s3) {
MkCoercion(&(arglink->nd_LEFT), d3);
}
else {
df_error(arg, "unexpected parameter type", edf);
break;
@ -1330,7 +1340,8 @@ ChkStandard(expp)
if (! getarg(&arglink, T_REAL, 0, edf)) return 0;
MkCoercion(&(arglink->nd_LEFT),
edf->df_value.df_stdname == S_TRUNCD ?
longint_type : card_type);
options['l'] ? longcard_type : longint_type
: card_type);
free_it = 1;
break;

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

@ -687,8 +687,8 @@ RangeCheck(tpl, tpr)
return;
}
tpr = BaseType(tpr);
if ((tpl->tp_fund == T_INTEGER && tpr == card_type) ||
(tpr->tp_fund == T_INTEGER && tpl == card_type)) {
if ((tpl->tp_fund == T_INTEGER && tpr->tp_fund == T_CARDINAL) ||
(tpr->tp_fund == T_INTEGER && tpl->tp_fund == T_CARDINAL)) {
label lb = ++text_label;
C_dup(tpr->tp_size);
@ -865,7 +865,7 @@ CodeOper(expr, true_label, false_label)
Operands(expr);
tp = BaseType(leftop->nd_type);
if (tp == intorcard_type) tp = BaseType(rightop->nd_type);
if (tp->tp_fund == T_INTORCARD) tp = BaseType(rightop->nd_type);
size = tp->tp_size;
switch (tp->tp_fund) {
case T_INTEGER:

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

@ -615,8 +615,8 @@ cstcall(expp, call)
if (tp->tp_fund == T_INTEGER) {
expr->nd_INT = max_int[(int)(tp->tp_size)];
}
else if (tp == card_type) {
expr->nd_INT = full_mask[(int)(int_size)];
else if (tp->tp_fund == T_CARDINAL) {
expr->nd_INT = full_mask[(int)(tp->tp_size)];
}
else if (tp->tp_fund == T_SUBRANGE) {
expr->nd_INT = tp->sub_ub;

4
lang/m2/comp/em_m2.6
View file

@ -65,8 +65,8 @@ make all procedure names global, so that \fIadb\fR(1) understands them.
.IP \fB\-g\fR
produce a DBX-style symbol table.
.IP \fB\-l\fR
enable local extensions. Currently, the only local extension consists of
procedure constants.
enable local extensions. Currently, there are two local extensions:
procedure constants, and the type LONGCARD.
.IP \fB\-s\fR
make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
This is useful for interpreters that use the "real" MIN(INTEGER) to

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

@ -221,6 +221,10 @@ AddStandards()
EnterType("REAL", real_type);
EnterType("LONGREAL", longreal_type);
EnterType("CARDINAL", card_type);
if (options['l']) {
/* local extension: LONGCARD. */
EnterType("LONGCARD", longcard_type);
}
EnterType("(void)", void_type);
df = Enter("NIL", D_CONST, address_type, 0);
df->con_const = nilconst;

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

@ -136,6 +136,7 @@ extern t_type
*byte_type,
*address_type,
*intorcard_type,
*longintorcard_type,
*bitset_type,
*void_type,
*std_type,

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

@ -70,6 +70,7 @@ t_type
*byte_type,
*address_type,
*intorcard_type,
*longintorcard_type,
*bitset_type,
*void_type,
*std_type,
@ -187,6 +188,7 @@ InitTypes()
longcard_type = standard_type(T_CARDINAL, long_align, long_size);
card_type = standard_type(T_CARDINAL, int_align, int_size);
intorcard_type = standard_type(T_INTORCARD, int_align, int_size);
longintorcard_type = standard_type(T_INTORCARD, long_align, long_size);
/* floating types
*/
@ -844,13 +846,13 @@ t_type *
intorcard(left, right)
register t_type *left, *right;
{
if (left == intorcard_type) {
if (left->tp_fund == T_INTORCARD) {
t_type *tmp = left;
left = right;
right = tmp;
}
if (right == intorcard_type) {
if (left == int_type || left == card_type) {
if (right->tp_fund == T_INTORCARD) {
if (left->tp_fund == T_INTEGER || left->tp_fund == T_CARDINAL) {
return left;
}
}

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

@ -111,8 +111,8 @@ TstCompat(tp1, tp2)
tp1 = BaseType(tp1);
tp2 = BaseType(tp2);
if (tp2 != intorcard_type &&
(tp1 == intorcard_type || tp1 == address_type)) {
if (tp2->tp_fund != T_INTORCARD &&
(tp1->tp_fund == T_INTORCARD || tp1 == address_type)) {
t_type *tmp = tp2;
tp2 = tp1;
@ -125,10 +125,15 @@ TstCompat(tp1, tp2)
&&
(tp1 == int_type || tp1 == card_type || tp1 == address_type)
)
||
( tp2 == longintorcard_type
&&
(tp1 == longint_type || tp1 == longcard_type || tp1 == address_type)
)
||
( tp2 == address_type
&&
( tp1 == card_type || tp1->tp_fund == T_POINTER)
( tp1->tp_fund == T_CARDINAL || tp1->tp_fund == T_POINTER)
)
;
}