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

some minor fixes, renamed ch7 stuff to ch3

Browse source
This commit is contained in:
eck 1989-09-25 14:28:10 +00:00
parent fa4e6eecb4
commit 00027d3893
15 changed files with 1281 additions and 92 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

88
lang/cem/cemcom.ansi/Makefile
View file

@ -71,20 +71,20 @@ LOBJ = tokenfile.o declar.o statement.o expression.o program.o Lpars.o ival.o
# Objects of hand-written C files
CSRC = main.c idf.c declarator.c decspecs.c struct.c \
expr.c ch7.c ch7bin.c cstoper.c fltcstoper.c arith.c \
expr.c ch3.c ch3bin.c cstoper.c fltcstoper.c arith.c \
code.c dumpidf.c error.c field.c\
tokenname.c LLlex.c LLmessage.c \
input.c domacro.c replace.c init.c options.c \
skip.c stack.c type.c ch7mon.c label.c eval.c \
skip.c stack.c type.c ch3mon.c label.c eval.c \
switch.c conversion.c util.c proto.c \
pragma.c blocks.c dataflow.c Version.c \
l_lint.c l_states.c l_misc.c l_ev_ord.c l_outdef.c l_comment.c l_dummy.c
COBJ = main.o idf.o declarator.o decspecs.o struct.o \
expr.o ch7.o ch7bin.o cstoper.o fltcstoper.o arith.o \
expr.o ch3.o ch3bin.o cstoper.o fltcstoper.o arith.o \
code.o dumpidf.o error.o field.o\
tokenname.o LLlex.o LLmessage.o \
input.o domacro.o replace.o init.o options.o \
skip.o stack.o type.o ch7mon.o label.o eval.o \
skip.o stack.o type.o ch3mon.o label.o eval.o \
switch.o conversion.o util.o proto.o \
pragma.o blocks.o dataflow.o Version.o \
l_lint.o l_states.o l_misc.o l_ev_ord.o l_outdef.o l_comment.o l_dummy.o
@ -405,34 +405,34 @@ expr.o: sizes.h
expr.o: spec_arith.h
expr.o: target_sizes.h
expr.o: type.h
ch7.o: Lpars.h
ch7.o: arith.h
ch7.o: assert.h
ch7.o: debug.h
ch7.o: def.h
ch7.o: expr.h
ch7.o: file_info.h
ch7.o: idf.h
ch7.o: label.h
ch7.o: lint.h
ch7.o: nobitfield.h
ch7.o: nopp.h
ch7.o: proto.h
ch7.o: spec_arith.h
ch7.o: struct.h
ch7.o: type.h
ch7bin.o: Lpars.h
ch7bin.o: arith.h
ch7bin.o: botch_free.h
ch7bin.o: expr.h
ch7bin.o: idf.h
ch7bin.o: label.h
ch7bin.o: lint.h
ch7bin.o: nobitfield.h
ch7bin.o: nopp.h
ch7bin.o: spec_arith.h
ch7bin.o: struct.h
ch7bin.o: type.h
ch3.o: Lpars.h
ch3.o: arith.h
ch3.o: assert.h
ch3.o: debug.h
ch3.o: def.h
ch3.o: expr.h
ch3.o: file_info.h
ch3.o: idf.h
ch3.o: label.h
ch3.o: lint.h
ch3.o: nobitfield.h
ch3.o: nopp.h
ch3.o: proto.h
ch3.o: spec_arith.h
ch3.o: struct.h
ch3.o: type.h
ch3bin.o: Lpars.h
ch3bin.o: arith.h
ch3bin.o: botch_free.h
ch3bin.o: expr.h
ch3bin.o: idf.h
ch3bin.o: label.h
ch3bin.o: lint.h
ch3bin.o: nobitfield.h
ch3bin.o: nopp.h
ch3bin.o: spec_arith.h
ch3bin.o: struct.h
ch3bin.o: type.h
cstoper.o: Lpars.h
cstoper.o: arith.h
cstoper.o: assert.h
@ -691,18 +691,18 @@ type.o: sizes.h
type.o: spec_arith.h
type.o: target_sizes.h
type.o: type.h
ch7mon.o: Lpars.h
ch7mon.o: arith.h
ch7mon.o: botch_free.h
ch7mon.o: def.h
ch7mon.o: expr.h
ch7mon.o: idf.h
ch7mon.o: label.h
ch7mon.o: lint.h
ch7mon.o: nobitfield.h
ch7mon.o: nopp.h
ch7mon.o: spec_arith.h
ch7mon.o: type.h
ch3mon.o: Lpars.h
ch3mon.o: arith.h
ch3mon.o: botch_free.h
ch3mon.o: def.h
ch3mon.o: expr.h
ch3mon.o: idf.h
ch3mon.o: label.h
ch3mon.o: lint.h
ch3mon.o: nobitfield.h
ch3mon.o: nopp.h
ch3mon.o: spec_arith.h
ch3mon.o: type.h
label.o: Lpars.h
label.o: arith.h
label.o: def.h

24
lang/cem/cemcom.ansi/arith.c
View file

@ -142,10 +142,10 @@ relbalance(e1p, oper, e2p)
if ((*e2p)->ex_type->tp_fund == FUNCTION)
function2pointer(*e2p);
if ((*e1p)->ex_type->tp_fund == POINTER)
ch76pointer(e2p, oper, (*e1p)->ex_type);
ch3pointer(e2p, oper, (*e1p)->ex_type);
else
if ((*e2p)->ex_type->tp_fund == POINTER)
ch76pointer(e1p, oper, (*e2p)->ex_type);
ch3pointer(e1p, oper, (*e2p)->ex_type);
else
if ( (*e1p)->ex_type == (*e2p)->ex_type &&
(*e1p)->ex_type->tp_fund == ENUM
@ -155,7 +155,7 @@ relbalance(e1p, oper, e2p)
arithbalance(e1p, oper, e2p);
}
ch76pointer(expp, oper, tp)
ch3pointer(expp, oper, tp)
struct expr **expp;
register struct type *tp;
{
@ -167,7 +167,7 @@ ch76pointer(expp, oper, tp)
if (exp->ex_type->tp_fund == POINTER) {
if (exp->ex_type != tp)
ch7cast(expp, oper, tp);
ch3cast(expp, oper, tp);
}
else
if (is_integral_type(exp->ex_type)) {
@ -177,14 +177,14 @@ ch76pointer(expp, oper, tp)
symbol2str(oper),
symbol2str(exp->ex_type->tp_fund));
}
ch7cast(expp, CAST, tp);
ch3cast(expp, CAST, tp);
}
else {
expr_error(exp, "%s on %s and pointer",
symbol2str(oper),
symbol2str(exp->ex_type->tp_fund)
);
ch7cast(expp, oper, tp);
ch3cast(expp, oper, tp);
}
}
@ -468,7 +468,7 @@ opnd2test(expp, oper)
if ((*expp)->ex_class == Oper && is_test_op((*expp)->OP_OPER))
{ /* It is already a test */ }
else
ch7bin(expp, NOTEQUAL, intexpr((arith)0, INT));
ch3bin(expp, NOTEQUAL, intexpr((arith)0, INT));
}
int
@ -542,19 +542,19 @@ field2arith(expp)
(*expp)->ex_type = atype;
if (atype->tp_unsigned) { /* don't worry about the sign bit */
ch7bin(expp, RIGHT, intexpr((arith)fd->fd_shift, INT));
ch7bin(expp, '&', intexpr(fd->fd_mask, INT));
ch3bin(expp, RIGHT, intexpr((arith)fd->fd_shift, INT));
ch3bin(expp, '&', intexpr(fd->fd_mask, INT));
}
else { /* take care of the sign bit: sign extend if needed */
arith bits_in_type = atype->tp_size * 8;
ch7bin(expp, LEFT,
ch3bin(expp, LEFT,
intexpr(bits_in_type - fd->fd_width - fd->fd_shift,
INT)
);
ch7bin(expp, RIGHT, intexpr(bits_in_type - fd->fd_width, INT));
ch3bin(expp, RIGHT, intexpr(bits_in_type - fd->fd_width, INT));
}
ch7cast(expp, CAST, tp); /* restore its original type */
ch3cast(expp, CAST, tp); /* restore its original type */
}
#endif NOBITFIELD

660
lang/cem/cemcom.ansi/ch3.c Normal file
View file

@ -0,0 +1,660 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Header$ */
/* S E M A N T I C A N A L Y S I S -- C H A P T E R 3.3 */
#include "lint.h"
#include "debug.h"
#include "nobitfield.h"
#include "idf.h"
#include <flt_arith.h>
#include "arith.h"
#include "proto.h"
#include "type.h"
#include "struct.h"
#include "label.h"
#include "expr.h"
#include "def.h"
#include "Lpars.h"
#include "assert.h"
#include "file_info.h"
extern char options[];
extern char *symbol2str();
extern struct type *qualifier_type();
/* Most expression-handling routines have a pointer to a
(struct type *) as first parameter. The object under the pointer
gets updated in the process.
*/
ch3sel(expp, oper, idf)
struct expr **expp;
struct idf *idf;
{
/* The selector idf is applied to *expp; oper may be '.' or
ARROW.
*/
register struct expr *exp;
register struct type *tp;
register struct sdef *sd;
any2opnd(expp, oper);
exp = *expp;
tp = exp->ex_type;
if (oper == ARROW) {
if (tp->tp_fund == POINTER &&
( tp->tp_up->tp_fund == STRUCT ||
tp->tp_up->tp_fund == UNION)) /* normal case */
tp = tp->tp_up;
else { /* constructions like "12->selector" and
"char c; c->selector"
*/
switch (tp->tp_fund) {
case POINTER:
break;
case INT:
case LONG:
/* An error is given in idf2sdef() */
ch3cast(expp, CAST, pa_type);
sd = idf2sdef(idf, tp);
tp = sd->sd_stype;
break;
default:
expr_error(exp, "-> applied to %s",
symbol2str(tp->tp_fund));
case ERRONEOUS:
exp->ex_type = error_type;
return;
}
}
} else { /* oper == '.' */
/* nothing */
}
exp = *expp;
switch (tp->tp_fund) {
case POINTER: /* for int *p; p->next = ... */
case STRUCT:
case UNION:
break;
case INT:
case LONG:
/* warning will be given by idf2sdef() */
break;
default:
if (!is_anon_idf(idf))
expr_error(exp, "selector %s applied to %s",
idf->id_text, symbol2str(tp->tp_fund));
case ERRONEOUS:
exp->ex_type = error_type;
return;
}
sd = idf2sdef(idf, tp);
if (oper == '.') {
/* there are 3 cases in which the selection can be
performed compile-time:
I: n.sel (n either an identifier or a constant)
II: (e.s1).s2 (transformed into (e.(s1+s2)))
III: (e->s1).s2 (transformed into (e->(s1+s2)))
The code performing these conversions is
extremely obscure.
*/
if (exp->ex_class == Value) {
/* It is an object we know the address of; so
we can calculate the address of the
selected member
*/
exp->VL_VALUE += sd->sd_offset;
exp->ex_type = sd->sd_type;
exp->ex_lvalue = exp->ex_type->tp_fund != ARRAY;
if (exp->ex_type == error_type) {
exp->ex_flags |= EX_ERROR;
}
}
else
if (exp->ex_class == Oper) {
struct oper *op = &(exp->ex_object.ex_oper);
if (op->op_oper == '.' || op->op_oper == ARROW) {
ASSERT(is_cp_cst(op->op_right));
op->op_right->VL_VALUE += sd->sd_offset;
exp->ex_type = sd->sd_type;
exp->ex_lvalue = exp->ex_type->tp_fund != ARRAY;
if (exp->ex_type == error_type) {
exp->ex_flags |= EX_ERROR;
}
}
else {
exp = new_oper(sd->sd_type, exp, '.',
intexpr(sd->sd_offset, INT));
exp->ex_lvalue = sd->sd_type->tp_fund != ARRAY;
if (!exp->OP_LEFT->ex_lvalue)
exp->ex_flags |= EX_ILVALUE;
}
}
}
else { /* oper == ARROW */
exp = new_oper(sd->sd_type,
exp, oper, intexpr(sd->sd_offset, INT));
exp->ex_lvalue = (sd->sd_type->tp_fund != ARRAY);
exp->ex_flags &= ~EX_ILVALUE;
}
if (sd->sd_type->tp_typequal & TQ_CONST)
exp->ex_flags |= EX_READONLY;
if (sd->sd_type->tp_typequal & TQ_VOLATILE)
exp->ex_flags |= EX_VOLATILE;
if (oper == '.' && exp->ex_flags & EX_READONLY) {
exp->ex_type = qualifier_type(exp->ex_type, TQ_CONST);
}
*expp = exp;
}
ch3incr(expp, oper)
struct expr **expp;
{
/* The monadic prefix/postfix incr/decr operator oper is
applied to *expp.
*/
ch3asgn(expp, oper, intexpr((arith)1, INT));
}
ch3cast(expp, oper, tp)
register struct expr **expp;
register struct type *tp;
{
/* The expression *expp is cast to type tp; the cast is
caused by the operator oper. If the cast has
to be passed on to run time, its left operand will be an
expression of class Type.
*/
register struct type *oldtp;
if (oper == RETURN && tp->tp_fund == VOID) {
strict("return <expression> in function returning void");
(*expp)->ex_type = void_type;
return;
}
if ((*expp)->ex_type->tp_fund == FUNCTION)
function2pointer(*expp);
if ((*expp)->ex_type->tp_fund == ARRAY)
array2pointer(*expp);
if ((*expp)->ex_class == String)
string2pointer(*expp);
oldtp = (*expp)->ex_type;
#ifndef NOBITFIELD
if (oldtp->tp_fund == FIELD) {
field2arith(expp);
ch3cast(expp, oper, tp);
}
else
if (tp->tp_fund == FIELD) {
ch3cast(expp, oper, tp->tp_up);
}
else
#endif NOBITFIELD
if (equal_type(tp, oldtp, 0)) {
/* life is easy */
}
else
if (tp->tp_fund == VOID) {
/* easy again */
(*expp)->ex_type = void_type;
}
else
if (is_arith_type(oldtp) && is_arith_type(tp)) {
int oldi = is_integral_type(oldtp);
int i = is_integral_type(tp);
if (oldi && i) {
#ifdef LINT
if (oper == CAST)
(*expp)->ex_type = tp;
else
int2int(expp, tp);
#else LINT
int2int(expp, tp);
#endif LINT
}
else
if (oldi && !i) {
#ifdef LINT
if (oper == CAST)
(*expp)->ex_type = tp;
else
int2float(expp, tp);
#else LINT
int2float(expp, tp);
#endif LINT
}
else
if (!oldi && i) {
#ifdef LINT
if (oper == CAST)
(*expp)->ex_type = tp;
else
float2int(expp, tp);
#else LINT
float2int(expp, tp);
#endif LINT
}
else {
/* !oldi && !i */
#ifdef LINT
if (oper == CAST)
(*expp)->ex_type = tp;
else
float2float(expp, tp);
#else LINT
float2float(expp, tp);
#endif LINT
}
}
else
if (oldtp->tp_fund == POINTER && tp->tp_fund == POINTER) {
if (oper == CASTAB)
expr_warning(*expp, "incompatible pointers");
else
if (oper != CAST)
expr_warning(*expp, "incompatible pointers in %s",
symbol2str(oper));
#ifdef LINT
if (oper != CAST)
lint_ptr_conv(oldtp->tp_up->tp_fund, tp->tp_up->tp_fund);
#endif LINT
(*expp)->ex_type = tp; /* free conversion */
}
else
if (oldtp->tp_fund == POINTER && is_integral_type(tp)) {
/* from pointer to integral */
if (oper != CAST)
expr_warning(*expp,
"illegal conversion of pointer to %s",
symbol2str(tp->tp_fund));
if (oldtp->tp_size > tp->tp_size)
expr_warning(*expp,
"conversion of pointer to %s loses accuracy",
symbol2str(tp->tp_fund));
if (oldtp->tp_size != tp->tp_size)
int2int(expp, tp);
else
(*expp)->ex_type = tp;
}
else
if (tp->tp_fund == POINTER && is_integral_type(oldtp)) {
/* from integral to pointer */
switch (oper) {
case CAST:
break;
case CASTAB:
case EQUAL:
case NOTEQUAL:
case '=':
case RETURN:
if (is_cp_cst(*expp) && (*expp)->VL_VALUE == (arith)0)
break;
default:
expr_warning(*expp,
"illegal conversion of %s to pointer",
symbol2str(oldtp->tp_fund));
break;
}
if (oldtp->tp_size > tp->tp_size)
expr_warning(*expp,
"conversion of %s to pointer loses accuracy",
symbol2str(oldtp->tp_fund));
if (oldtp->tp_size != tp->tp_size)
int2int(expp, tp);
else
(*expp)->ex_type = tp;
}
else
if (oldtp->tp_fund == ERRONEOUS) {
/* we just won't look */
(*expp)->ex_type = tp; /* brute force */
}
else
if (oldtp->tp_size == tp->tp_size && oper == CAST) {
expr_warning(*expp, "dubious conversion based on equal size");
(*expp)->ex_type = tp; /* brute force */
}
else {
if (oldtp->tp_fund != ERRONEOUS && tp->tp_fund != ERRONEOUS)
expr_error(*expp, "cannot convert %s to %s",
symbol2str(oldtp->tp_fund),
symbol2str(tp->tp_fund)
);
(*expp)->ex_type = tp; /* brute force */
}
if (oper == CAST) {
(*expp)->ex_flags |= EX_ILVALUE;
}
}
/* Determine whether two types are equal.
*/
equal_type(tp, otp, check_qual)
register struct type *tp, *otp;
int check_qual;
{
if (tp == otp)
return 1;
if (!tp || !otp)
return 0;
if (tp->tp_fund != otp->tp_fund)
return 0;
if (tp->tp_unsigned != otp->tp_unsigned)
return 0;
if (tp->tp_align != otp->tp_align)
return 0;
if (tp->tp_fund != ARRAY /* && tp->tp_fund != STRUCT */ ) { /* UNION ??? */
if (tp->tp_size != otp->tp_size)
return 0;
}
switch (tp->tp_fund) {
case FUNCTION:
/* If both types have parameter type lists, the type of
each parameter in the composite parameter type list
is the composite type of the corresponding paramaters.
*/
if (tp->tp_proto && otp->tp_proto) {
if (!equal_proto(tp->tp_proto, otp->tp_proto))
return 0;
} else if (tp->tp_proto || otp->tp_proto) {
if (!legal_mixture(tp, otp))
return 0;
}
return equal_type(tp->tp_up, otp->tp_up, 0);
case ARRAY:
/* If one type is an array of known size, the composite
type is an array of that size
*/
if (tp->tp_size != otp->tp_size &&
(tp->tp_size != -1 && otp->tp_size != -1))
return 0;
return equal_type(tp->tp_up, otp->tp_up, check_qual);
case POINTER:
if (equal_type(tp->tp_up, otp->tp_up, check_qual)) {
if (otp->tp_up->tp_typequal & TQ_CONST) {
if (!(tp->tp_up->tp_typequal & TQ_CONST)) {
strict("illegal use of pointer to const object");
}
}
if (otp->tp_up->tp_typequal & TQ_VOLATILE) {
if (!(tp->tp_up->tp_typequal & TQ_VOLATILE)) {
strict("illegal use of pointer to volatile object");
}
}
return 1;
}
else return 0;
case FIELD:
return equal_type(tp->tp_up, otp->tp_up, check_qual);
case STRUCT:
case UNION:
case ENUM:
return tp->tp_idf == otp->tp_idf && tp->tp_sdef == otp->tp_sdef;
default:
return 1;
}
}
check_pseudoproto(pl, opl)
register struct proto *pl, *opl;
{
int retval = 1;
if (pl->pl_flag & PL_ELLIPSIS) {
error("illegal ellipsis terminator");
return 2;
}
if (opl->pl_flag & PL_VOID) {
if (!(pl->pl_flag & PL_VOID))
error("function is defined without parameters");
pl->pl_flag |= PL_ERRGIVEN;
opl->pl_flag |= PL_ERRGIVEN;
return 2;
}
while (pl && opl) {
if (!equal_type(pl->pl_type, opl->pl_type, 0)) {
if (!(pl->pl_flag & PL_ERRGIVEN)
&& !(opl->pl_flag & PL_ERRGIVEN))
error("incorrect type for parameter %s of definition",
opl->pl_idf->id_text);
pl->pl_flag |= PL_ERRGIVEN;
opl->pl_flag |= PL_ERRGIVEN;
retval = 2;
}
pl = pl->next;
opl = opl->next;
}
if (pl || opl) {
error("incorrect number of parameters");
retval = 2;
}
return retval;
}
legal_mixture(tp, otp)
struct type *tp, *otp;
{
register struct proto *pl = tp->tp_proto, *opl = otp->tp_proto;
int retval = 1;
struct proto *prot;
int fund;
ASSERT( (pl != 0) ^ (opl != 0));
if (pl) {
prot = pl;
} else {
prot = opl;
}
if (!opl && otp->tp_pseudoproto) {
return check_pseudoproto(tp->tp_proto, otp->tp_pseudoproto);
}
if (prot->pl_flag & PL_ELLIPSIS) {
if (!(prot->pl_flag & PL_ERRGIVEN)) {
if (pl)
error("illegal ellipsis terminator");
else error("ellipsis terminator in previous (prototype) declaration");
}
prot->pl_flag |= PL_ERRGIVEN;
prot = prot->next;
return 2;
}
while (prot) {
/* if (!(prot->pl_flag & PL_ELLIPSIS)) {} */
fund = prot->pl_type->tp_fund;
if (fund == CHAR || fund == SHORT || fund == FLOAT) {
if (!(prot->pl_flag & PL_ERRGIVEN))
error("illegal %s parameter in %sdeclaration",
symbol2str(fund), (opl ? "previous (prototype) " : "" ));
prot->pl_flag |= PL_ERRGIVEN;
retval = 2;
}
prot = prot->next;
}
return retval;
}
equal_proto(pl, opl)
register struct proto *pl, *opl;
{
if (pl == opl)
return 1;
/* If only one type is a function type with a parameter type list
(a function prototype), the composite type is a function
prototype with parameter type list.
*/
while ( pl && opl) {
if ((pl->pl_flag & ~PL_ERRGIVEN) != (opl->pl_flag & ~PL_ERRGIVEN))
return 0;
if (!equal_type(pl->pl_type, opl->pl_type, 0))
return 0;
pl = pl->next;
opl = opl->next;
}
return !(pl || opl);
}
/* check if a type has a const declared member */
recurconst(tp)
struct type *tp;
{
register struct sdef *sdf;
ASSERT(tp);
if (!tp) return 0;
if (tp->tp_typequal & TQ_CONST) return 1;
sdf = tp->tp_sdef;
while (sdf) {
if (recurconst(sdf->sd_type))
return 1;
sdf = sdf->sd_sdef;
}
return 0;
}
ch3asgn(expp, oper, expr)
struct expr **expp;
struct expr *expr;
{
/* The assignment operators.
"f op= e" should be interpreted as
"f = (typeof f)((typeof (f op e))f op (typeof (f op e))e)"
and not as "f = f op (typeof f)e".
Consider, for example, (i == 10) i *= 0.9; (i == 9), where
typeof i == int.
The resulting expression tree becomes:
op=
/ \
/ \
f (typeof (f op e))e
EVAL should however take care of evaluating (typeof (f op e))f
*/
register struct expr *exp = *expp;
int fund = exp->ex_type->tp_fund;
int vol = 0;
struct type *tp;
/* We expect an lvalue */
if (!exp->ex_lvalue) {
expr_error(exp, "no lvalue in operand of %s", symbol2str(oper));
} else if (exp->ex_flags & EX_ILVALUE) {
strict("incorrect lvalue in operand of %s", symbol2str(oper));
} else if (exp->ex_flags & EX_READONLY) {
expr_error(exp, "operand of %s is read-only", symbol2str(oper));
} else if (fund == STRUCT || fund == UNION) {
if (recurconst(exp->ex_type))
expr_error(expr,"operand of %s contains a const-qualified member",
symbol2str(oper));
}
/* Preserve volatile markers across the tree.
This is questionable, depending on the way the optimizer
wants this information.
vol = (exp->ex_flags & EX_VOLATILE) || (expr->ex_flags & EX_VOLATILE);
*/
if (oper == '=') {
ch3cast(&expr, oper, exp->ex_type);
tp = expr->ex_type;
}
else { /* turn e into e' where typeof(e') = typeof (f op e) */
struct expr *extmp = intexpr((arith)0, INT);
/* this is really $#@&*%$# ! */
/* if you correct this, please correct lint_new_oper() too */
extmp->ex_lvalue = 1;
extmp->ex_type = exp->ex_type;
ch3bin(&extmp, oper, expr);
/* Note that ch3bin creates a tree of the expression
((typeof (f op e))f op (typeof (f op e))e),
where f ~ extmp and e ~ expr.
We want to use (typeof (f op e))e.
Ch7bin does not create a tree if both operands
were illegal or constants!
*/
tp = extmp->ex_type; /* perform the arithmetic in type tp */
if (extmp->ex_class == Oper) {
expr = extmp->OP_RIGHT;
extmp->OP_RIGHT = NILEXPR;
free_expression(extmp);
}
else
expr = extmp;
}
#ifndef NOBITFIELD
if (fund == FIELD)
exp = new_oper(exp->ex_type->tp_up, exp, oper, expr);
else
exp = new_oper(exp->ex_type, exp, oper, expr);
#else NOBITFIELD
exp = new_oper(exp->ex_type, exp, oper, expr);
#endif NOBITFIELD
exp->OP_TYPE = tp; /* for EVAL() */
exp->ex_flags |= vol ? (EX_SIDEEFFECTS|EX_VOLATILE) : EX_SIDEEFFECTS;
*expp = exp;
}
/* Some interesting (?) questions answered.
*/
int
is_integral_type(tp)
register struct type *tp;
{
switch (tp->tp_fund) {
case GENERIC:
case CHAR:
case SHORT:
case INT:
case LONG:
case ENUM:
return 1;
#ifndef NOBITFIELD
case FIELD:
return is_integral_type(tp->tp_up);
#endif NOBITFIELD
default:
return 0;
}
}
int
is_arith_type(tp)
register struct type *tp;
{
switch (tp->tp_fund) {
case GENERIC:
case CHAR:
case SHORT:
case INT:
case LONG:
case ENUM:
case FLOAT:
case DOUBLE:
case LNGDBL:
return 1;
#ifndef NOBITFIELD
case FIELD:
return is_arith_type(tp->tp_up);
#endif NOBITFIELD
default:
return 0;
}
}

352
lang/cem/cemcom.ansi/ch3bin.c Normal file
View file

@ -0,0 +1,352 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Header$ */
/* SEMANTIC ANALYSIS (CHAPTER 3.3) -- BINARY OPERATORS */
#include "botch_free.h"
#include <alloc.h>
#include "lint.h"
#include "idf.h"
#include <flt_arith.h>
#include "arith.h"
#include "type.h"
#include "struct.h"
#include "label.h"
#include "expr.h"
#include "Lpars.h"
extern char options[];
extern char *symbol2str();
/* This chapter asks for the repeated application of code to handle
an operation that may be executed at compile time or at run time,
depending on the constancy of the operands.
*/
#define commutative_binop(expp, oper, expr) mk_binop(expp, oper, expr, 1)
#define non_commutative_binop(expp, oper, expr) mk_binop(expp, oper, expr, 0)
ch3bin(expp, oper, expr)
register struct expr **expp;
struct expr *expr;
{
/* apply binary operator oper between *expp and expr.
NB: don't swap operands if op is one of the op= operators!!!
*/
any2opnd(expp, oper);
any2opnd(&expr, oper);
switch (oper) {
case '[': /* 3.3.2.1 */
/* indexing follows the commutative laws */
switch ((*expp)->ex_type->tp_fund) {
case POINTER:
case ARRAY:
break;
case ERRONEOUS:
return;
default: /* unindexable */
switch (expr->ex_type->tp_fund) {
case POINTER:
case ARRAY:
break;
case ERRONEOUS:
return;
default:
expr_error(*expp,
"indexing an object of type %s",
symbol2str((*expp)->ex_type->tp_fund));
return;
}
break;
}
ch3bin(expp, '+', expr);
ch3mon('*', expp);
break;
case '(': /* 3.3.2.2 */
if ( (*expp)->ex_type->tp_fund == POINTER &&
(*expp)->ex_type->tp_up->tp_fund == FUNCTION
) {
ch3mon('*', expp);
}
if ((*expp)->ex_type->tp_fund != FUNCTION) {
expr_error(*expp, "call of non-function (%s)",
symbol2str((*expp)->ex_type->tp_fund));
/* leave the expression; it may still serve */
free_expression(expr); /* there go the parameters */
*expp = new_oper(error_type,
*expp, '(', (struct expr *)0);
}
else
*expp = new_oper((*expp)->ex_type->tp_up,
*expp, '(', expr);
(*expp)->ex_flags |= EX_SIDEEFFECTS;
break;
case PARCOMMA: /* 3.3.2.2 */
if ((*expp)->ex_type->tp_fund == FUNCTION)
function2pointer(*expp);
*expp = new_oper(expr->ex_type, *expp, PARCOMMA, expr);
break;
case '%':
case MODAB:
case ANDAB:
case XORAB:
case ORAB:
opnd2integral(expp, oper);
opnd2integral(&expr, oper);
/* fallthrough */
case '/':
case DIVAB:
case TIMESAB:
arithbalance(expp, oper, &expr);
non_commutative_binop(expp, oper, expr);
break;
case '&':
case '^':
case '|':
opnd2integral(expp, oper);
opnd2integral(&expr, oper);
/* fallthrough */
case '*':
arithbalance(expp, oper, &expr);
commutative_binop(expp, oper, expr);
break;
case '+':
if (expr->ex_type->tp_fund == POINTER) { /* swap operands */
struct expr *etmp = expr;
expr = *expp;
*expp = etmp;
}
/* fallthrough */
case PLUSAB:
case POSTINCR:
case PLUSPLUS:
if ((*expp)->ex_type->tp_fund == POINTER) {
pointer_arithmetic(expp, oper, &expr);
if (expr->ex_type->tp_size != (*expp)->ex_type->tp_size)
ch3cast(&expr, CAST, (*expp)->ex_type);
pointer_binary(expp, oper, expr);
}
else {
arithbalance(expp, oper, &expr);
if (oper == '+')
commutative_binop(expp, oper, expr);
else
non_commutative_binop(expp, oper, expr);
}
break;
case '-':
case MINAB:
case POSTDECR:
case MINMIN:
if ((*expp)->ex_type->tp_fund == POINTER) {
if (expr->ex_type->tp_fund == POINTER)
pntminuspnt(expp, oper, expr);
else {
pointer_arithmetic(expp, oper, &expr);
pointer_binary(expp, oper, expr);
}
}
else {
arithbalance(expp, oper, &expr);
non_commutative_binop(expp, oper, expr);
}
break;
case LEFT:
case RIGHT:
case LEFTAB:
case RIGHTAB:
opnd2integral(expp, oper);
opnd2integral(&expr, oper);
arithbalance(expp, oper, &expr); /* ch. 7.5 */
ch3cast(&expr, oper, int_type); /* cvt. rightop to int */
non_commutative_binop(expp, oper, expr);
break;
case '<':
case '>':
case LESSEQ:
case GREATEREQ:
case EQUAL:
case NOTEQUAL:
relbalance(expp, oper, &expr);
non_commutative_binop(expp, oper, expr);
(*expp)->ex_type = int_type;
break;
case AND:
case OR:
opnd2test(expp, oper);
opnd2test(&expr, oper);
if (is_cp_cst(*expp)) {
register struct expr *ex = *expp;
/* the following condition is a short-hand for
((oper == AND) && o1) || ((oper == OR) && !o1)
where o1 == (*expp)->VL_VALUE;
and ((oper == AND) || (oper == OR))
*/
if ((oper == AND) == (ex->VL_VALUE != (arith)0))
*expp = expr;
else {
ex->ex_flags |= expr->ex_flags;
free_expression(expr);
*expp = intexpr((arith)((oper == AND) ? 0 : 1),
INT);
}
(*expp)->ex_flags |= ex->ex_flags;
free_expression(ex);
}
else
if (is_cp_cst(expr)) {
/* Note!!!: the following condition is a short-hand for
((oper == AND) && o2) || ((oper == OR) && !o2)
where o2 == expr->VL_VALUE
and ((oper == AND) || (oper == OR))
*/
if ((oper == AND) == (expr->VL_VALUE != (arith)0)) {
(*expp)->ex_flags |= expr->ex_flags;
free_expression(expr);
}
else {
if (oper == OR)
expr->VL_VALUE = (arith)1;
ch3bin(expp, ',', expr);
}
}
else {
*expp = new_oper(int_type, *expp, oper, expr);
}
(*expp)->ex_flags |= EX_LOGICAL;
break;
case ':':
if ( is_struct_or_union((*expp)->ex_type->tp_fund)
|| is_struct_or_union(expr->ex_type->tp_fund)
) {
if (!equal_type((*expp)->ex_type, expr->ex_type, 0))
expr_error(*expp, "illegal balance");
}
else
relbalance(expp, oper, &expr);
#ifdef LINT
if ( (is_cp_cst(*expp) && is_cp_cst(expr))
&& (*expp)->VL_VALUE == expr->VL_VALUE
) {
hwarning("operands of : are constant and equal");
}
#endif LINT
*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
break;
case '?':
opnd2logical(expp, oper);
if (is_cp_cst(*expp)) {
#ifdef LINT
hwarning("condition in ?: expression is constant");
#endif LINT
*expp = (*expp)->VL_VALUE ?
expr->OP_LEFT : expr->OP_RIGHT;
}
else {
*expp = new_oper(expr->ex_type, *expp, oper, expr);
}
break;
case ',':
if (is_cp_cst(*expp))
*expp = expr;
else
*expp = new_oper(expr->ex_type, *expp, oper, expr);
(*expp)->ex_flags |= EX_COMMA;
break;
}
}
pntminuspnt(expp, oper, expr)
register struct expr **expp, *expr;
{
/* Subtracting two pointers is so complicated it merits a
routine of its own.
*/
struct type *up_type = (*expp)->ex_type->tp_up;
if (!equal_type(up_type, expr->ex_type->tp_up, 0)) {
expr_error(*expp, "subtracting incompatible pointers");
free_expression(expr);
erroneous2int(expp);
return;
}
/* we hope the optimizer will eliminate the load-time
pointer subtraction
*/
*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
ch3cast(expp, CAST, pa_type); /* ptr-ptr: result has pa_type */
ch3bin(expp, '/',
intexpr(size_of_type(up_type, "object"), pa_type->tp_fund));
ch3cast(expp, CAST, int_type); /* result will be an integer expr */
}
mk_binop(expp, oper, expr, commutative)
struct expr **expp;
register struct expr *expr;
{
/* Constructs in *expp the operation indicated by the operands.
"commutative" indicates whether "oper" is a commutative
operator.
*/
register struct expr *ex = *expp;
if (is_cp_cst(expr) && is_cp_cst(ex))
cstbin(expp, oper, expr);
else if (is_fp_cst(expr) && is_fp_cst(ex))
fltcstbin(expp, oper, expr);
else {
*expp = (commutative && expr->ex_depth >= ex->ex_depth) ?
new_oper(ex->ex_type, expr, oper, ex) :
new_oper(ex->ex_type, ex, oper, expr);
}
}
pointer_arithmetic(expp1, oper, expp2)
register struct expr **expp1, **expp2;
{
int typ;
/* prepares the integral expression expp2 in order to
apply it to the pointer expression expp1
*/
if ((typ = any2arith(expp2, oper)) == FLOAT
|| typ == DOUBLE
|| typ == LNGDBL) {
expr_error(*expp2,
"illegal combination of %s and pointer",
symbol2str(typ));
erroneous2int(expp2);
}
ch3bin( expp2, '*',
intexpr(size_of_type((*expp1)->ex_type->tp_up, "object"),
pa_type->tp_fund)
);
}
pointer_binary(expp, oper, expr)
register struct expr **expp, *expr;
{
/* constructs the pointer arithmetic expression out of
a pointer expression, a binary operator and an integral
expression.
*/
if (is_ld_cst(expr) && is_ld_cst(*expp))
cstbin(expp, oper, expr);
else
*expp = new_oper((*expp)->ex_type, *expp, oper, expr);
}

168
lang/cem/cemcom.ansi/ch3mon.c Normal file
View file

@ -0,0 +1,168 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Header$ */
/* SEMANTIC ANALYSIS (CHAPTER 3.3) -- MONADIC OPERATORS */
#include "botch_free.h"
#include <alloc.h>
#include "nobitfield.h"
#include "Lpars.h"
#include <flt_arith.h>
#include "arith.h"
#include "type.h"
#include "label.h"
#include "expr.h"
#include "idf.h"
#include "def.h"
extern char options[];
extern arith full_mask[/*MAXSIZE*/]; /* cstoper.c */
char *symbol2str();
ch3mon(oper, expp)
register struct expr **expp;
{
/* The monadic prefix operator oper is applied to *expp.
*/
register struct expr *expr;
switch (oper) {
case '*': /* 3.3.3.2 */
/* no FIELD type allowed */
if ((*expp)->ex_type->tp_fund == ARRAY)
array2pointer(*expp);
if ((*expp)->ex_type->tp_fund != POINTER) {
if ((*expp)->ex_type->tp_fund != FUNCTION) {
expr_error(*expp,
"* applied to non-pointer (%s)",
symbol2str((*expp)->ex_type->tp_fund));
} else {
warning("superfluous use of * on function");
/* ignore indirection (yegh) */
}
} else {
expr = *expp;
if (expr->ex_lvalue == 0 && expr->ex_class != String)
/* dereference in administration only */
expr->ex_type = expr->ex_type->tp_up;
else /* runtime code */
*expp = new_oper(expr->ex_type->tp_up, NILEXPR,
'*', expr);
(*expp)->ex_lvalue = (
(*expp)->ex_type->tp_fund != ARRAY &&
(*expp)->ex_type->tp_fund != FUNCTION
);
if ((*expp)->ex_type->tp_typequal & TQ_CONST)
(*expp)->ex_flags |= EX_READONLY;
if ((*expp)->ex_type->tp_typequal & TQ_VOLATILE)
(*expp)->ex_flags |= EX_VOLATILE;
(*expp)->ex_flags &= ~EX_ILVALUE;
}
break;
case '&':
if ((*expp)->ex_type->tp_fund == ARRAY) {
expr_warning(*expp, "& before array ignored");
array2pointer(*expp);
}
else
if ((*expp)->ex_type->tp_fund == FUNCTION) {
expr_warning(*expp, "& before function ignored");
function2pointer(*expp);
}
else
#ifndef NOBITFIELD
if ((*expp)->ex_type->tp_fund == FIELD)
expr_error(*expp, "& applied to field variable");
else
#endif NOBITFIELD
if (!(*expp)->ex_lvalue)
expr_error(*expp, "& applied to non-lvalue");
else if ((*expp)->ex_flags & EX_ILVALUE)
expr_error(*expp, "& applied to illegal lvalue");
else {
/* assume that enums are already filtered out */
if (ISNAME(*expp)) {
register struct def *def =
(*expp)->VL_IDF->id_def;
/* &<var> indicates that <var>
cannot be used as register
anymore
*/
if (def->df_sc == REGISTER) {
expr_error(*expp,
"& on register variable not allowed");
break; /* break case '&' */
}
}
(*expp)->ex_type = pointer_to((*expp)->ex_type,
(*expp)->ex_type->tp_typequal);
(*expp)->ex_lvalue = 0;
(*expp)->ex_flags &= ~EX_READONLY;
}
break;
case '~':
{
int fund = (*expp)->ex_type->tp_fund;
if (fund == FLOAT || fund == DOUBLE || fund == LNGDBL) {
expr_error( *expp,
"~ not allowed on %s operands",
symbol2str(fund));
erroneous2int(expp);
break;
}
/* FALLTHROUGH */
}
case '-':
any2arith(expp, oper);
if (is_cp_cst(*expp)) {
arith o1 = (*expp)->VL_VALUE;
(*expp)->VL_VALUE = (oper == '-') ? -o1 :
((*expp)->ex_type->tp_unsigned ?
(~o1) & full_mask[(*expp)->ex_type->tp_size] :
~o1
);
}
else
if (is_fp_cst(*expp))
switch_sign_fp(*expp);
else
*expp = new_oper((*expp)->ex_type,
NILEXPR, oper, *expp);
break;
case '!':
if ((*expp)->ex_type->tp_fund == FUNCTION)
function2pointer(*expp);
if ((*expp)->ex_type->tp_fund != POINTER)
any2arith(expp, oper);
opnd2test(expp, '!');
if (is_cp_cst(*expp)) {
(*expp)->VL_VALUE = !((*expp)->VL_VALUE);
(*expp)->ex_type = int_type; /* a cast ???(EB) */
}
else
*expp = new_oper(int_type, NILEXPR, oper, *expp);
(*expp)->ex_flags |= EX_LOGICAL;
break;
case PLUSPLUS:
case MINMIN:
ch3incr(expp, oper);
break;
case SIZEOF:
if (ISNAME(*expp) && (*expp)->VL_IDF->id_def->df_formal_array)
expr_warning(*expp, "sizeof formal array %s is sizeof pointer!",
(*expp)->VL_IDF->id_text);
expr = intexpr((*expp)->ex_class == String ?
(arith)((*expp)->SG_LEN) :
size_of_type((*expp)->ex_type, "object"),
INT);
expr->ex_flags |= EX_SIZEOF;
free_expression(*expp);
*expp = expr;
break;
}
}

4
lang/cem/cemcom.ansi/code.c
View file

@ -337,7 +337,7 @@ do_return_expr(expr)
/* do_return_expr() generates the expression and the jump for
a return statement with an expression.
*/
ch7cast(&expr, RETURN, func_type);
ch3cast(&expr, RETURN, func_type);
code_expr(expr, RVAL, TRUE, NO_LABEL, NO_LABEL);
C_bra(return_label);
return_expr_occurred = 1;
@ -504,7 +504,7 @@ loc_init(expr, id)
}
}
else { /* not embraced */
ch7cast(&expr, '=', tp); /* may modify expr */
ch3cast(&expr, '=', tp); /* may modify expr */
#ifndef LINT
{
struct value vl;

9
lang/cem/cemcom.ansi/declar.g
View file

@ -641,7 +641,14 @@ parameter_declarator(register struct declarator *dc;)
parameter_type_list(&pl)
|
formal_list(&fm)
]?
|
/* empty */
{
pl = new_proto();
pl->pl_type = void_type;
pl->pl_flag = PL_VOID;
}
]
')'
{ add_decl_unary(dc, FUNCTION, 0, (arith)0, fm, pl);
reject_params(dc);

2
lang/cem/cemcom.ansi/expr.c
View file

@ -395,7 +395,7 @@ new_oper(tp, e1, oper, e2)
expr->ex_depth =
(e1_depth > e2->ex_depth ? e1_depth : e2->ex_depth) + 1;
expr->ex_flags = (e1_flags | e2->ex_flags)
& ~(EX_PARENS | EX_READONLY /* ??? | EX_VOLATILE */ );
& ~(EX_PARENS | EX_READONLY | EX_VOLATILE );
}
op = &expr->ex_object.ex_oper;
op->op_type = tp;

26
lang/cem/cemcom.ansi/expression.g
View file

@ -85,13 +85,13 @@ postfix_expression(register struct expr **expp;)
primary(expp)
[
'[' expression(&e1) ']'
{ ch7bin(expp, '[', e1); e1 = 0; }
{ ch3bin(expp, '[', e1); e1 = 0; }
|
'(' parameter_list(&e1)? ')'
{ ch7bin(expp, '(', e1); call_proto(expp); e1 = 0; }
{ ch3bin(expp, '(', e1); call_proto(expp); e1 = 0; }
|
[ '.' | ARROW ] { oper = DOT; }
identifier(&idf) { ch7sel(expp, oper, idf); }
identifier(&idf) { ch3sel(expp, oper, idf); }
]*
[
[
@ -99,7 +99,7 @@ postfix_expression(register struct expr **expp;)
|
MINMIN { oper = POSTDECR; }
]
{ ch7incr(expp, oper); }
{ ch3incr(expp, oper); }
]?
;
@ -112,7 +112,7 @@ parameter_list(struct expr **expp;)
','
assignment_expression(&e1)
{any2opnd(&e1, PARCOMMA);}
{ch7bin(expp, PARCOMMA, e1);}
{ch3bin(expp, PARCOMMA, e1);}
]*
;
@ -124,14 +124,14 @@ unary(register struct expr **expp;)
:
%if (first_of_type_specifier(AHEAD) && AHEAD != IDENTIFIER)
cast(&tp) unary(expp)
{ ch7cast(expp, CAST, tp);
{ ch3cast(expp, CAST, tp);
(*expp)->ex_flags |= EX_CAST;
}
|
postfix_expression(expp)
|
unop(&oper) unary(expp)
{ch7mon(oper, expp);}
{ch3mon(oper, expp);}
|
size_of(expp)
;
@ -152,7 +152,7 @@ size_of(register struct expr **expp;)
}
|
unary(expp)
{ch7mon(SIZEOF, expp);}
{ch3mon(SIZEOF, expp);}
]
{ InSizeof--; }
;
@ -216,7 +216,7 @@ binary_expression(int maxrank; struct expr **expp;)
}
binary_expression(rank_of(oper)-1, &e1)
{
ch7bin(expp, oper, e1);
ch3bin(expp, oper, e1);
ResultKnown = OldResultKnown;
}
]*
@ -249,9 +249,9 @@ conditional_expression(struct expr **expp;)
{
check_conditional(e2, '=', "not allowed after :");
ResultKnown = OldResultKnown;
ch7bin(&e1, ':', e2);
ch3bin(&e1, ':', e2);
opnd2test(expp, '?');
ch7bin(expp, '?', e1);
ch3bin(expp, '?', e1);
}
]?
;
@ -266,7 +266,7 @@ assignment_expression(struct expr **expp;)
[%prefer /* (rank_of(DOT) <= maxrank) for any asgnop */
asgnop(&oper)
assignment_expression(&e1)
{ch7asgn(expp, oper, e1);}
{ch3asgn(expp, oper, e1);}
|
empty /* LLgen artefact ??? */
]
@ -280,7 +280,7 @@ expression(struct expr **expp;)
[ ','
assignment_expression(&e1)
{
ch7bin(expp, ',', e1);
ch3bin(expp, ',', e1);
}
]*
;

5
lang/cem/cemcom.ansi/idf.c
View file

@ -414,7 +414,7 @@ global_redecl(idf, new_sc, tp)
register struct def *def = idf->id_def;
int retval;
if (!(retval = equal_type(tp, def->df_type)))
if (!(retval = equal_type(tp, def->df_type, 0)))
error("redeclaration of %s with different type", idf->id_text);
else if (retval == 1)
update_proto(tp, def->df_type);
@ -609,7 +609,7 @@ check_formals(idf, dc)
}
while(fm && pl) {
if (!equal_type(promoted_type(fm->fm_idf->id_def->df_type)
, pl->pl_type)) {
, pl->pl_type, 0)) {
if (!(pl->pl_flag & PL_ERRGIVEN))
error("incorrect type for parameter %s"
, fm->fm_idf->id_text);
@ -638,6 +638,7 @@ check_formals(idf, dc)
}
if (pl == 0) { /* make func(void) */
pl = new_proto();
pl->pl_type = void_type;
pl->pl_flag = PL_VOID;
}
idf->id_def->df_type->tp_pseudoproto = pl;

8
lang/cem/cemcom.ansi/ival.g
View file

@ -447,7 +447,7 @@ check_ival(expp, tp)
register struct type *tp;
struct expr **expp;
{
/* The philosophy here is that ch7cast puts an explicit
/* The philosophy here is that ch3cast puts an explicit
conversion node in front of the expression if the types
are not compatible. In this case, the initialisation
expression is no longer a constant.
@ -461,7 +461,7 @@ check_ival(expp, tp)
case LONG:
case ENUM:
case POINTER:
ch7cast(expp, '=', tp);
ch3cast(expp, '=', tp);
expr = *expp;
#ifdef DEBUG
print_expr("init-expr after cast", expr);
@ -491,7 +491,7 @@ check_ival(expp, tp)
case FLOAT:
case DOUBLE:
case LNGDBL:
ch7cast(expp, '=', tp);
ch3cast(expp, '=', tp);
expr = *expp;
#ifdef DEBUG
print_expr("init-expr after cast", expr);
@ -527,7 +527,7 @@ and also to prevent runtime coercions for compile-time constants.
#ifndef NOBITFIELD
case FIELD:
ch7cast(expp, '=', tp->tp_up);
ch3cast(expp, '=', tp->tp_up);
expr = *expp;
#ifdef DEBUG
print_expr("init-expr after cast", expr);

10
lang/cem/cemcom.ansi/l_misc.c
View file

@ -52,14 +52,14 @@ lint_new_oper(expr)
right == 0 ? 0 : /* for ( without parameters */
right->ex_type->tp_fund;
/* In ch7.c, in ch7asgn(), a combined operator/assignment
/* In ch3.c, in ch3asgn(), a combined operator/assignment
is hammered into correctness by repeated application of
ch7bin(), which calls new_oper(), which calls lint_new_oper().
ch3bin(), which calls new_oper(), which calls lint_new_oper().
These spurious calls understandably cause spurious error
messages, which we don't like. So we try to suppress these
wierd calls here. This refers to the code marked
this is really $#@&*%$# !
in ch7asgn().
in ch3asgn().
*/
switch (oper) {
case PLUSAB:
@ -103,7 +103,7 @@ lint_new_oper(expr)
else {
/* binary */
if (l_fund == ENUM && r_fund == ENUM) {
if (!equal_type(left->ex_type, right->ex_type))
if (!equal_type(left->ex_type, right->ex_type, 0))
warning("subtracting enums of different type");
/* update the type, cem does not do it */
expr->ex_type = int_type;
@ -164,7 +164,7 @@ lint_new_oper(expr)
case EQUAL:
case NOTEQUAL:
if ( (l_fund == ENUM || r_fund == ENUM)
&& !equal_type(left->ex_type, right->ex_type)
&& !equal_type(left->ex_type, right->ex_type, 0)
) {
warning("comparing enum with non-enum");
}

2
lang/cem/cemcom.ansi/proto.c
View file

@ -482,7 +482,7 @@ call_proto(expp)
break;
}
else if (!(pstack[pcnt]->pl_flag & PL_ELLIPSIS)) {
ch7cast(estack[ecnt],CASTAB,pstack[pcnt]->pl_type);
ch3cast(estack[ecnt],CASTAB,pstack[pcnt]->pl_type);
pcnt--;
} else
any2parameter(estack[ecnt]);

13
lang/cem/cemcom.ansi/struct.c
View file

@ -252,22 +252,23 @@ idf2sdef(idf, tp)
register struct idf *idf;
struct type *tp;
{
/* The identifier idf is identified as a selector, preferably
in the struct tp, but we will settle for any unique
identification.
If the attempt fails, a selector of type error_type is
/* The identifier idf is identified as a selector
in the struct tp.
If there is no such member, give a member with the same
name.
If this fails too, a selector of type error_type is
created.
*/
register struct sdef **sdefp = &idf->id_sdef, *sdef;
/* Follow chain from idf, to meet tp. */
while ((sdef = *sdefp)) {
if (equal_type(sdef->sd_stype, tp))
if (equal_type(sdef->sd_stype, tp, 0))
return sdef;
sdefp = &(*sdefp)->next;
}
/* Tp not met; any unique identification will do. */
/* Tp not met; take an identification. */
if (sdef = idf->id_sdef) {
/* There is an identification */
error("illegal use of selector %s", idf->id_text);

2
lang/cem/cemcom.ansi/switch.c
View file

@ -156,7 +156,7 @@ code_case(expr)
}
if (expr->ex_flags & EX_ERROR) /* is probably 0 anyway */
return;
ch7cast(&expr, CASE, sh->sh_type);
ch3cast(&expr, CASE, sh->sh_type);
ce = new_case_entry();
C_df_ilb(ce->ce_label = text_label());
ce->ce_value = val = expr->VL_VALUE;