home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The C Users' Group Library 1994 August
/
wc-cdrom-cusersgrouplibrary-1994-08.iso
/
vol_300
/
357_01
/
cstar1.exe
/
EXP.C
< prev
next >
Wrap
C/C++ Source or Header
|
1991-06-18
|
64KB
|
2,710 lines
/*
C* -- Expression parsing routines.
source: exp.c
started: November 2, 1985
version:
February 17, 1987
March 7, 1989
PUBLIC DOMAIN SOFTWARE
The CSTAR program was placed in the public domain on June 15, 1991,
by its author and sole owner,
Edward K. Ream
1617 Monroe Street
Madison, WI 53711
(608) 257-0802
CSTAR may be used for any commercial or non-commercial purpose.
See cstar.h or cstar.c for a DISCLAIMER OF WARRANTIES.
*/
#include "cstar.h"
/*
CAUTION: about extending casts: see lint.doc. Extension is done first,
then sign conversion. This is built into exp.c/pe_fold1(),
g2.c/sop_cast(), and x2.c/x_cast(). Note also that pointer addition
depends on x_cast, so that if x_cast() is made to extend in a
different way, the dependent calls may have to be modified to keep
pointer addition correct. Pointer addition calls for a result of
x_cast() as int_type or long_type (i.e. signed), so this should not
be a substantial problem unless unsigned-to-signed extending casts
are altered, which would be a botch. (But committees do make botches.)
Since pointer addition should never overflow, except possibly when
the (folded) scaled offset is added to the pointer, it should be clear
in all cases what needs to happen.
*/
/*
type is:
ASSIGN_EXPR for expression having outer effect
ANY_EXPR for nonnull expression
CONST_EXPR for primitive or composite constant
XARITH_EXPR for expression usable as boolean
ARG_EXPR for expression usable as argument
The pe_list1() and pe_expr1() routines call each other without resetting
the token and node stacks. The externally visible versions do reset
those stacks.
*/
/*
Externally visible routines:
*/
struct node * pe_list (register int type);
int pe_oversize (int mclass, long value);
struct node * pe_expr (void);
struct node * pe_expr1 (bool comma_ok);
bool pe_check (struct node * p, int type);
void pe_massage (register struct type_node *t1,
register struct node *p2, int op);
int pe_number (struct node * p);
void pe_retype (int mclass, register struct node * p2,
int op);
/*
Internal routines.
*/
static int pe_can_reduce (register int opr1, register int opr2);
static void pe_cl_check (int oldclass, int newclass,
long value, int op);
static struct node * pe_cprim (void);
static void pe_init (void);
static bool pe_islval (register struct node *p, int op);
static struct node * pe_fold1 (register struct node * p);
static struct node * pe_fold2 (register struct node * p);
static struct node * pe_list1 (register int type);
static struct node * pe_npop (void);
static void pe_npush (register struct node * p);
static struct type_node * pe_opop (void);
static void pe_opush (struct type_node *tp);
static int pe_prec (int op);
static struct node * pe_prim (void);
static void pe_reduce (int op, struct type_node *t);
static unsigned long pe_sizeof (void);
static int pe_sprim (struct node * p);
static int pe_tcheck (void);
static void pe_tpop (void);
static void pe_tpush (int tok);
static bool pe_type1 (register struct node * p);
static bool pe_type2 (register struct node * p);
static bool pe_type3 (register struct node * p);
static bool pe_zcheck (struct node *p);
/*
NOTE: pe_cprim(), pe_prim() depend on the structure of the target machine to
a limited extent. It appears that gen_pp may be too late to do
some aspects of these setups.
*/
/*
Define data structures used only by this file.
*/
#define MAX_STACK 2000
static byte expr_stk [MAX_STACK];
static byte * tok_ptr; /* Top of operator stack. */
static struct node ** node_ptr; /* Top of expression stack. */
static int free_count; /* Free elements in stacks. */
static int tok_count; /* # of operators in stack. */
static int node_count; /* # of expressions in stack. */
/*
Certain shared items
*/
extern struct type_node *intrn_decl;
extern struct type_node *intrn_ptr;
/*
----- INTERNAL ROUTINES -----
*/
/*
Stack routines.
*/
static void
pe_tpush(int tok)
{
/* CAUTION: this is used rather arbitrarily, and should not
interrogate t_type or any of the other t_ globals. */
/* compare ascending and descending pointers */
TRACEPB("pe_tpush", printf("(%d)\n", tok));
if (tok_ptr + 4 > (void *) node_ptr) {
fatal("expression too complex");
}
*( CAST(int *) tok_ptr ) = tok;
tok_ptr += sizeof(tok);
tok_count++;
TICKX("pe_tpush");
}
/* check if there is token-stack, needed for ternary reduce */
static int
pe_tcheck(void)
{
TICK("pe_tcheck");
return (tok_ptr >= &expr_stk[0] + sizeof(int));
}
#define look_tok() ( *( (CAST(int *) (void *) tok_ptr) - 1) )
/* returns an int! */
static void
pe_tpop(void)
{
TICKB("pe_tpop");
if (tok_ptr < &expr_stk[0] + sizeof(int)) {
fatal("pe_tpop: can't be done");
}
tok_ptr -= sizeof(int);
tok_count--;
TICKX("pe_tpop");
}
/* operator subtype to stack */
static void
pe_opush(struct type_node *tp)
{
/* compare ascending and descending pointers */
TRACEPB("pe_opush", printf("(%p)\n", tp));
if (tok_ptr + 4 > (void *) node_ptr) {
fatal("expression too complex");
}
*( CAST(void **) tok_ptr ) = tp;
tok_ptr += sizeof(struct type_node *);
TICKX("pe_opush");
}
static struct type_node *
pe_opop(void)
{
register struct type_node * tp;
TICKB("pe_opop");
if (tok_ptr < &expr_stk[0] + sizeof(tp)) {
fatal("pe_opop: can't be done");
}
tok_ptr -= sizeof(struct type_node *);
tp = *(CAST (void **) tok_ptr);
RETURN_PTR("pe_opop", tp);
}
static void
pe_npush(register struct node * p)
{
TRACEPB("pe_npush", printf("(%p)\n", p));
if (p == NULL) {
t_error("pe_npush: internal: NULL node");
}
if (tok_ptr + 4 > (void *) node_ptr) {
fatal("expression too complex");
}
*--node_ptr = p;
node_count++;
TICKX("pe_npush");
}
static struct node *
pe_npop(void)
{
register struct node * p;
TICKB("pe_npop");
if (node_count <= 0) {
fatal("pe_npop: internal: ran out of nodes");
}
p = *node_ptr++;
node_count--;
RETURN_PTR("pe_npop", p);
}
/*
Return TRUE if a tree p could be an lvalue if the types are right
Otherwise return FALSE and give the error.
This allows pe_typex() to detect certain errors.
Lvalue form has root as an identifier, U*, array, ., or ->
*/
bool
pe_islval(register struct node *p, int op)
{
TRACEPB("pe_islval", printf("(%p, %d)\n", p, op));
switch (p -> n_type) {
case ID_TOK:
if (p -> n_cid == NULL) {
RETURN_BOOL("pe_islval", FALSE); /* it's a constant */
}
RETURN_BOOL("pe_islval", TRUE);
case USTAR_TOK:
case DOT_TOK:
case ARROW_TOK:
case ARRAY_TOK:
RETURN_BOOL("pe_islval", TRUE);
case CAST_TOK:
if (pe_islval(p -> n_arg1, p -> n_arg1 -> n_type)) {
RETURN_BOOL("pe_islval", TRUE);
}
/* FALLTHROUGH */
default:
t_2error("operand not assignable: ", ps_tok(op));
}
RETURN_BOOL("pe_islval", FALSE);
}
/*
Return TRUE if we can reduce opr1 when opr2 follows.
Return TRUE if opr1 has higher precedence than opr2.
Else if opr1 and opr2 have the same precedence,
return TRUE if they associate left to right.
This code reflects the table on page 49 of K & R, except that
LPAREN_TOK has the LOWEST precedence and associates R to L.
*/
static int
pe_can_reduce(register int opr1, register int opr2)
{
register int prec1, prec2;
TRACEPB("pe_can_reduce", printf("(%d, %d)\n", opr1, opr2));
if (opr1 == LPAREN_TOK) {
/* Force the pushing of opr2. */
RETURN_INT("pe_can_reduce", FALSE);
}
prec1 = pe_prec(opr1);
prec2 = pe_prec(opr2);
if (prec1 > prec2) {
RETURN_INT("pe_can_reduce", TRUE);
}
else if (prec1 < prec2) {
RETURN_INT("pe_can_reduce", FALSE);
}
/* prec1 == 3 is the ternary */
else if (prec1 == 14 || prec1 == 3 || prec1 == 2) {
/* Associate right to left. */
RETURN_INT("pe_can_reduce", FALSE);
}
else {
/* Associate left to right. */
RETURN_INT("pe_can_reduce", TRUE);
}
}
/*
Return the precedence of an operator.
Parentheses are handled separately.
This code reflects the table on page 49 of K & R.
If an operator can be both unary and binary, the default
form (not known yet whether unary or binary) must be the
binary form. Consider a + b &
*/
static int
pe_prec(int op)
{
TRACEP("pe_prec", printf("(%s)\n", ps_tok(op)));
switch (op) {
case LBRACK_TOK:
case LPAREN_TOK:
case ARROW_TOK:
case DOT_TOK: return 15;
case NOT_TOK: case TILDE_TOK:
case INC_TOK: case DEC_TOK:
case PRE_INC_TOK: case PRE_DEC_TOK:
case POST_INC_TOK: case POST_DEC_TOK:
case UMINUS_TOK:
case USTAR_TOK: case UAND_TOK:
case K_SIZEOF:
case CAST_TOK:
return 14;
case STAR_TOK:
case DIV_TOK:
case MOD_TOK: return 13;
case PLUS_TOK:
case MINUS_TOK: return 12;
case LSHIFT_TOK:
case RSHIFT_TOK: return 11;
case LT_TOK:
case LE_TOK:
case GT_TOK:
case GE_TOK: return 10;
case EQUAL_TOK:
case NE_TOK: return 9;
case AND_TOK: return 8;
case XOR_TOK: return 7;
case OR_TOK: return 6;
case LAND_TOK: return 5;
case LOR_TOK: return 4;
case QUESTION_TOK:
case COLON_TOK:
return 3;
case ASSN_TOK: case AND_ASSN_TOK:
case DIV_ASSN_TOK: case LSHIFT_ASSN_TOK:
case MINUS_ASSN_TOK: case MOD_ASSN_TOK:
case OR_ASSN_TOK: case PLUS_ASSN_TOK:
case RSHIFT_ASSN_TOK: case STAR_ASSN_TOK:
case XOR_ASSN_TOK:
return 2;
case COMMA_TOK:
return 1;
default:
printf("pe_prec: bad operator: %d, %s\n",op, ps_tok(op));
fatal("pe_prec");
}
}
/*
Check an expression to see if it is of the indicated type.
Call t_error() if it isn't.
*/
bool
pe_check(struct node * p, int type)
{
TRACEPB("pe_check", printf("(%p, %d)\n", p, type));
if (p == NULL) {
t_error("empty expression");
RETURN_BOOL("pe_check", FALSE);
}
switch (type) {
case ANY_EXPR:
RETURN_BOOL("pe_check", TRUE);
/* expression having an effect */
/* WARNING: comma expressions */
case ASSIGN_EXPR:
switch(p -> n_type) {
case PRE_INC_TOK: case PRE_DEC_TOK:
case POST_INC_TOK: case POST_DEC_TOK:
case ASSN_TOK: case AND_ASSN_TOK:
case DIV_ASSN_TOK: case LSHIFT_ASSN_TOK:
case MINUS_ASSN_TOK: case MOD_ASSN_TOK:
case OR_ASSN_TOK: case PLUS_ASSN_TOK:
case RSHIFT_ASSN_TOK: case STAR_ASSN_TOK:
case XOR_ASSN_TOK:
RETURN_BOOL("pe_check", TRUE);
default:
TRACE("pe_check", printf("p -> n_type = %d\n", p -> n_type));
if (p -> n_cltype &&
p->n_cltype -> t_typtok == VOID_TYPE) {
}
else {
if (p -> n_type == CALL_TOK) {
t_help("unused function-return value");
}
else {
t_warning("unused value at outer level");
}
}
}
RETURN_BOOL("pe_check", FALSE);
case CONST_EXPR:
switch(p -> n_type) {
case INT_TOK:
case STRING_TOK:
t_error("internal: pe_check: unprocessed const_tok");
RETURN_BOOL("pe_check", FALSE);
case ID_TOK:
if (pe_number(p)) {
RETURN_BOOL("pe_check", TRUE);
}
else {
RETURN_BOOL("pe_check", FALSE);
}
default:
t_error("non-constant constant expression");
RETURN_BOOL("pe_check", FALSE);
}
case XARITH_EXPR:
if (p -> n_cltype) switch (p -> n_cltype -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
RETURN_BOOL("pe_check", TRUE);
case ARRAY_TYPE:
t_warning("array name is apt to be always true");
RETURN_BOOL("pe_check", TRUE);
case VOID_TYPE:
t_error("boolean expression is of void type");
break;
default:
t_error("boolean expression has no arithmetic value");
}
else {
t_error("internal: untyped boolean expression");
}
RETURN_BOOL("pe_check", FALSE);
case ARG_EXPR:
if (p -> n_cltype) switch (p -> n_cltype -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
case ARRAY_TYPE:
RETURN_BOOL("pe_check", TRUE);
case STRUCT_TYPE:
case UNION_TYPE:
t_error("argument is a structure");
break;
case VOID_TYPE:
t_error("argument is of void type");
break;
default:
t_error("argument has no arithmetic value");
}
else {
t_error("internal: untyped boolean expression");
}
RETURN_BOOL("pe_check", FALSE);
default:
TRACEP("pe_check", printf("bad type: %d\n", type));
fatal("internal: pe_check: called with bad type");
RETURN_BOOL("pe_check", FALSE);
}
}
/*
Parse a comma list of expressions.
THIS MUST NOT BE CALLED INSIDE AN EXPRESSION!!!!!!
That is, called directly or indirectly by pe_expr()
pe_list INITIALIZES expr. use ALIST1 instead.
*/
struct node *
pe_list(int type)
{
TRACEPB("pe_list", printf("(%d)\n", type));
pe_init();
RETURN_PTR("pe_list", pe_list1(type));
}
/*
parse the comma list; make a cons_node only if there are two
or more arguments
*/
static struct node *
pe_list1(register int type)
{
register struct node * p;
register struct node * q;
struct node * head, *prev;
TRACEPB("pe_list1", printf("(%d)\n", type));
head = NULL;
prev = NULL;
for (;;) {
p = pe_expr1(FALSE);
if (p == NULL) {
break;
}
(void) pe_check(p, type);
if (head == NULL) {
/* No cons node needed yet. */
head = p;
}
else {
q = new_pnode(sizeof(struct cons_node));
q -> n_type = SEPARATOR_TOK;
if (prev == NULL) {
/* Initial cons node. No unlinking to do. */
q -> n_car = head;
q -> n_next = p;
head = q;
prev = q;
}
else {
/* Change the list structure. */
q -> n_car = prev -> n_next;
q -> n_next = p;
prev -> n_next = q;
prev = q;
}
}
/* Continue as long as comma is seen. */
if (t_type != COMMA_TOK) {
break;
}
get_token();
}
RETURN_PTR("pe_list1", head);
}
/*
Parse an arbitrary C expression, commas allowed if comma is TRUE
The code below uses an operator precedence algorithm which
uses an operator stack and a node stack, both housed in expr_stk[].
Several auxiliary routines handle these stacks:
pe_tpush(), pe_tpop(), pe_npush() and pe_npop();
*/
static void
pe_init(void)
{
byte * cp;
TICK("pe_init");
/* Initialize the stacks. */
free_count = MAX_STACK-8;
tok_count = 0;
node_count = 0;
tok_ptr = &expr_stk[0];
cp = (void *) &expr_stk[0];
cp += (MAX_STACK-4);
node_ptr = /* (void *) */ CAST(struct node **) cp;
return;
}
struct node *
pe_expr(void)
{
TICKB("pe_expr");
pe_init();
RETURN_PTR("pe_expr", pe_expr1(TRUE));
}
/* pe_expr1 is visible for use by dcl.c in parsing array subscripts in casts */
struct node *
pe_expr1(bool comma_ok)
{
/* these items are for save-and-restore */
byte * tok_psave;
struct node ** node_psave;
int free_csave;
int tok_csave;
int node_csave;
register struct node * p;
register struct node * p2;
register int op;
register struct type_node *t;
register int ternary;
register int g_f;
/* save the stacks */
TRACEPB("pe_expr1", printf("(comma ok: %d)\n", comma_ok));
tok_psave = tok_ptr;
node_psave = node_ptr;
free_csave = free_count;
tok_csave = tok_count;
node_csave = node_count;
ternary = 0;
/*
Handle null expressions cleanly.
*/
switch(t_type) {
case COMMA_TOK:
if (comma_ok) {
break;
}
/* FALLTHROUGH */
case SEMICOLON_TOK:
case RPAREN_TOK:
RETURN_PTR("pe_expr1", NULL);
}
/*
State S1: Start of expression
handle unary ops or '('
push them on the stack for evaluation later.
*/
s1:
TRACEP("pe_expr1", printf("state s1, t_type %d, line %d\n",
t_type, t_line));
/* The sizeof operator is handled by pe_prim(). */
/* t_type is as currently provided via get_token */
switch (t_type) {
case TILDE_TOK:
case NOT_TOK: break;
case INC_TOK: t_type = PRE_INC_TOK; break;
case DEC_TOK: t_type = PRE_DEC_TOK; break;
case AND_TOK: t_type = UAND_TOK; break;
case STAR_TOK: t_type = USTAR_TOK; break;
case PLUS_TOK: t_type = UPLUS_TOK; break;
case LPAREN_TOK:
/* Possible cast, look ahead */
TRACEP("pe_expr1", printf("s1: check for cast\n"));
get_token();
t = pd_cast();
if (t != NULL) {
pe_opush(t);
pe_tpush(CAST_TOK);
need(RPAREN_TOK);
}
else {
TRACEP("pe_expr1", printf("s1: not a cast\n"));
pe_tpush(LPAREN_TOK);
comma_ok++;
TRACEP("pe_expr1", printf("comma_ok++, comma_ok == %d\n", comma_ok));
}
goto s1;
case MINUS_TOK:
t_type = UMINUS_TOK;
TRACEP("pe_expr1", printf("s1: unary minus special handling\n"));
get_token();
/* look ahead at the next token */
switch (t_type) {
case CHAR_TOK:
case INT_TOK:
case LONG_TOK:
/*
tamper with t_value and go to state s2
with the negative t_value in place. this
saves parsing one useless unary -, which is
OK, but what is important is that it
allows pe_cprim to see the negative constant,
which is probably what the programmer also
sees, and raise warnings, e.g. about an
apparent integer that's actually long.
*/
t_value = -t_value;
goto s2;
default:
/* set things as though lookahead had never happened */
pe_tpush(UMINUS_TOK);
goto s1;
}
default:
goto s2;
}
TRACEP("pe_expr1", printf("s1: fall-through\n"));
pe_tpush(t_type);
get_token();
goto s1;
/*
State S2:
We expect and must have a primitive (i.e., an identifier or constant)
at this point.
Push it onto the node stack.
*/
s2:
TRACEP("pe_expr1", printf("state s2\n"));
p = pe_prim();
TRACEP("pe_expr1", printf("state s2: prim returns node type %d\n",
p -> n_type));
/*
WARNING: we have to keep the books balanced or else an
expression will be totally botched by too many pulls
on pe_npop, given that an incomplete expression is
present in an argument parsed underneath by pe_list()
*/
if (p == NULL) {
p = new_pnode(sizeof(struct loc_node));
p -> n_cltype = new_tnode();
p -> n_type = ID_TOK;
}
pe_npush(p);
/*
State S3: After an identifier
Take care of the post-operator, if any.
*/
s3:
TRACEP("pe_expr1", printf("state s3\n"));
switch (t_type) {
case INC_TOK:
t_type = POST_INC_TOK;
g_f = 1;
break;
case DEC_TOK:
t_type = POST_DEC_TOK;
g_f = 1;
break;
case POST_DEC_TOK:
case POST_INC_TOK:
break;
case LPAREN_TOK:
case LBRACK_TOK:
g_f = 0;
break;
default:
goto s4;
}
TRACEP("pe_expr1", printf("s3: reducing post %s\n", ps_tok(t_type)));
if (tok_count > tok_csave && pe_can_reduce(op = look_tok(), t_type)) {
/* reduce what is already on the stack */
pe_tpop();
if (op == CAST_TOK) {
t = pe_opop();
}
else {
t = NULL;
}
pe_reduce(op, t);
}
else {
pe_reduce(t_type, NULL);
if (g_f) {
get_token();
}
}
goto s3;
/*
State S4:
End of expression, or continuation via binary operator,
or balanced right parenthesis.
If it is not a continuation,
the whole op stack gets used up, at which point it exits.
If it is a continuation, the op stack gets popped only until
t_type has a higher precedence than the operator on top.
The operator has already been obtained via get_token().
*/
s4:
TRACEP("pe_expr1", printf("state s4\n"));
if (tok_count <= tok_csave) {
TRACEP("pe_expr1", printf("stack empty. t_type=%d\n",t_type));
switch(t_type) {
case RBRACK_TOK:
case RPAREN_TOK:
case SEMICOLON_TOK:
goto s5;
case COMMA_TOK:
if (!comma_ok) {
goto s5;
}
pe_tpush(t_type);
get_token();
goto s1;
case COLON_TOK:
/* this colon always ends an expression, since there is
no operator stack, and so no ? on the stack */
TRACEP("pe_expr1", printf("terminal :\n"));
goto s5;
case QUESTION_TOK:
/* question marks are counted in case excess :
is found while something is on stack */
TRACEP("pe_expr1", printf("ternary++\n"));
ternary++;
pe_tpush(t_type);
get_token();
goto s1;
case LONG_TOK:
case INT_TOK:
case STRING_TOK:
t_error("extra constant ignored");
get_token();
goto s4;
case ID_TOK:
t_2error("extra identifier ignored: ", t_symbol);
get_token();
goto s4;
}
if (is_binop(t_type)) {
/* Valid operator. Push it and enter S1. */
pe_tpush(t_type);
get_token();
goto s1;
}
else if (is_unop(t_type)) {
t_2error("extra unary operator ignored: ",
ps_tok(t_type));
get_token();
goto s4;
}
else {
if (t_type == X_TOK || t_type == Z_TOK) {
t_2error("expression runs into reserved: ",
t_symbol);
}
else if (ps_tok(t_type)) {
t_2error("expression runs into: ",
ps_tok(t_type));
}
else {
t_error("runon expression");
}
goto s5;
}
}
/*
The operator stack is not empty.
Compare the operator on the op stack with the current operator.
The operator on the stack may be a cast operator
Operators are popped here and in reduce()
This is the later part of s4
*/
op = look_tok();
TRACEP("expr", printf("s4a: op = %d %s, ternary = %d\n",
op, ps_tok(op), ternary));
/* unknown or known reducible t_types get reduced */
/* known and nonreducible t_types get pushed at pushit: */
switch(t_type) {
case RPAREN_TOK:
if (op == LPAREN_TOK) {
if (comma_ok > 0) {
comma_ok--;
}
TRACEP("pe_expr1", printf("comma_ok--, comma_ok == %d\n", comma_ok));
/* cancel LPAREN & enter after-prim state */
pe_tpop();
get_token();
goto s3;
}
/* here RPAREN is a terminator and flushes the stack */
break;
case QUESTION_TOK:
if (pe_can_reduce(op, t_type)) {
break;
/* go reduce stack and try again */
}
/* first of ternary pair */
TRACEP("pe_expr1", printf("ternary++\n"));
ternary++;
goto pushit;
case COLON_TOK:
/* second of ternary pair */
if (pe_can_reduce(op, t_type) || ternary == 0) {
break;
}
ternary--;
goto pushit;
case COMMA_TOK:
if (!comma_ok || pe_can_reduce(op, t_type)) {
break;
}
goto pushit;
default:
if (!is_binop(t_type)) {
TRACEP("pe_expr1",printf("not binop: %d\n", t_type));
break;
}
if (pe_can_reduce(op, t_type)) {
break;
}
/* FALLTHROUGH */
pushit:
pe_tpush(t_type);
get_token();
goto s1;
}
/* reduce the operator that's on the stack and try again */
pe_tpop();
if (op == CAST_TOK) {
t = pe_opop();
TRACEP("pe_expr1",printf("cast type %\n", t));
}
else if (op == LPAREN_TOK) {
t_error("excess or misplaced ( in expression");
goto s4;
}
else {
t = NULL;
}
pe_reduce (op,t);
goto s4;
/*
State S5: End of expression.
*/
s5:
TRACEP("pe_expr1", printf("s5: node_count = %d , %d (local)\n",
node_count, node_count-node_csave));
p = pe_npop(); /* the last one off the stack */
TRACE("pe_expr1_list", pr_expr(p));
TRACE("pe_expr1_list", printf("\n"));
if (node_count != node_csave) {
t_error("too many operands (node stack not empty on exit)");
}
tok_ptr = tok_psave;
node_ptr = node_psave;
free_count = free_csave;
tok_count = tok_csave;
node_count = node_csave;
TRACE("pe_npush",
printf("pe_expr1: node_ptr set to %p on exit\n", node_ptr));
RETURN_PTR("pe_expr1", p);
}
/*
Reduce unary, binary, or ternary operator (including '[')
by popping operands off the node stack and repushing a result.
*/
static void
pe_reduce(int op, struct type_node *t)
{
register struct node * p, * q;
TRACEPB("pe_reduce", printf("op=%d %s, t=%p\n",
op, ps_tok(op), t));
if (is_unop(op) || op == POST_INC_TOK || op == POST_DEC_TOK) {
/* Create a new unary node. */
p = new_pnode(sizeof(struct unop_node));
p -> n_type = op;
p -> n_arg1 = pe_npop();
p -> n_cltype = t;
/* Fold constant expressions. */
TRACEP("pe_reduce", printf("new unary node %p\n", p));
if ((q = pe_fold1(p)) == NULL) {
(void) pe_type1(p);
pe_npush(p);
}
else {
pe_npush(q);
}
}
else if (op == LBRACK_TOK) {
get_token();
q = new_pnode(sizeof(struct binop_node));
q -> n_type = ARRAY_TOK;
q -> n_arg2 = pe_expr1(TRUE);
q -> n_arg1 = pe_npop(); /* array-id expression */
if ((p = pe_fold2(q)) == NULL) {
(void) pe_type2(q);
p = q;
}
(void) needend(RBRACK_TOK);
TRACEP("pe_reduce", printf("array, p = %p\n", p));
pe_npush(p);
}
else if (op == LPAREN_TOK) {
get_token();
p = new_pnode(sizeof(struct call_node));
p -> n_type = CALL_TOK;
p -> n_arg2 = q = pe_list1(ARG_EXPR);
if (q && q -> n_type != SEPARATOR_TOK) {
call_1arg++;
}
p -> n_arg1 = pe_npop(); /* function-id expression */
(void) pe_type2(p);
(void) needend(RPAREN_TOK);
TRACEP("pe_reduce", printf("function call, p = %p\n", p));
pe_npush(p);
}
else if (is_binop(op)) {
/* Create a binary node. */
p = new_pnode(sizeof(struct binop_node));
p -> n_type = op;
TRACEP("pe_reduce",printf("new binary node %p\n", p));
/* Reduce the operator on the top of the stack. */
p -> n_arg2 = pe_npop();
p -> n_arg1 = pe_npop();
/* CAUTION: pe_fold2 can convert binary (-) to unary (-) */
if ((q = pe_fold2(p)) == NULL) {
(void) pe_type2(p);
TRACEP("pe_type2",
printf("%p->%p: ", p, p -> n_cltype);
pr_type(p -> n_cltype); printf("\n"));
pe_npush(p);
}
else {
pe_npush(q);
}
}
else if (op == COLON_TOK) {
TRACEP("pe_reduce",printf("colon operator\n"));
/* Create a ternary node, maybe */
if (!pe_tcheck()) {
t_error("unexpected \':\'");
(void) pe_npop();
}
else if ( (op = look_tok()) == QUESTION_TOK) {
pe_tpop();
p = new_pnode(sizeof(struct ternop_node));
p -> n_type = QUESTION_TOK;
p -> n_arg3 = pe_npop();
p -> n_arg2 = pe_npop();
p -> n_arg1 = pe_npop();
if (pe_type3(p)) {
/* p = fold3(p) */
}
pe_npush(p);
}
else {
/* just align the stack */
(void) pe_npop();
t_error("unexpected \':\'");
}
}
else if (op == QUESTION_TOK) {
TRACEP("pe_reduce",printf("bad ? operator\n"));
/* just align the stack */
(void) pe_npop();
t_error("? without associated :");
}
else {
/* a bad op should never be pushed in the first place! */
printf("pe_reduce: bad operator %d\n", op);
fatal("pe_reduce: bad operator");
}
TICKX("pe_reduce");
}
/*
Check a PARSER operand to see if it is a constant of value zero
and a scalar type
*/
static bool
pe_zcheck(struct node *p)
{
TRACEPB("pe_zcheck", printf("(%p)\n", p));
if (p && p -> n_type == ID_TOK &&
p -> n_cid == NULL && p -> n_const == 0L &&
p -> n_reg1 == 0) {
if (p -> n_cltype) {
switch(p -> n_cltype -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
RETURN_BOOL("pe_zcheck", TRUE);
}
}
}
RETURN_BOOL("pe_zcheck", FALSE);
}
/*
Set type involving a unary operator.
A type always gets attached to p, and the routine returns
FALSE if that type had to be made of whole cloth.
(If it is desired to have the made-up type be VOID instead
of INT, do it here, and don't change new_tnode!)
*/
static bool
pe_type1(register struct node * p)
{
register struct node *p1;
register struct type_node *t, *t1;
register int op;
TRACEPB("pe_type1", printf("(%p)\n", p));
p1 = p -> n_arg1;
op = p -> n_type;
if (p1 == NULL) {
t_2error("pe_type1: internal: no arg of unary operator: ",
ps_tok(op));
if (p -> n_cltype == NULL) {
p -> n_cltype = new_tnode();
}
RETURN_BOOL("pe_type1", FALSE);
}
TRACEP("pe_type1", printf("node %p, op %d: %s\n", p, op, ps_tok(op)));
t1 = p1 -> n_cltype;
if (t1 == NULL) {
t_2error("pe_type1: internal: untyped arg of unary operator: ",
ps_tok(op));
TRACEP("pe_type1",
printf("arg is:\n"); pr_expr(p1); printf("\n"));
if (p -> n_cltype == NULL) {
p -> n_cltype = new_tnode();
}
RETURN_BOOL("pe_type1", FALSE);
}
else if (op != CAST_TOK) {
/* default setting */
p -> n_cltype = t1;
}
switch (op) {
case CAST_TOK:
t = p -> n_cltype;
/* t1 is the argument type */
if (t -> t_typtok != VOID_TYPE) switch (t1 -> t_typtok) {
case POINTER_TYPE:
if (t -> t_tsize < t1 -> t_tsize) {
t_warning("pointer cast to narrower type");
}
break;
case STRUCT_TYPE:
case ARRAY_TYPE:
case UNION_TYPE:
case FUNCTION_TYPE:
t_warning("address-of required?");
t_error("cast from an aggregate");
break;
}
/* t is the cast type */
switch (t -> t_typtok) {
case INT_TYPE:
if ((t -> t_mclass & UNSIGNED_MOD) &&
t1 -> t_typtok == INT_TYPE &&
!(t1 -> t_mclass & UNSIGNED_MOD) &&
(t -> t_tsize > t1 -> t_tsize) ) {
t_warning("ambiguous cast will extend then convert");
}
break;
case POINTER_TYPE:
switch (t1 -> t_typtok) {
case POINTER_TYPE:
case ARRAY_TYPE:
switch(t -> t_link -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
switch(t1->t_link->t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
if(t1 -> t_link -> t_tsize !=
t -> t_link -> t_tsize) {
t_help("coerced pointer: beware of 68000 scalar alignment");
}
}
}
}
if (t -> t_tsize != t1 -> t_tsize) {
t_warning("type of mismatching width cast to pointer");
}
break;
case STRUCT_TYPE:
case UNION_TYPE:
case FUNCTION_TYPE:
t_error("cast into an aggregate");
break;
}
break;
case UMINUS_TOK:
if (t1 -> t_typtok == INT_TYPE &&
t1 -> t_mclass & UNSIGNED_MOD) {
t_warning("negation of unsigned item");
}
/* FALLTHROUGH */
case TILDE_TOK:
case UPLUS_TOK:
if (t1 -> t_typtok != INT_TYPE) {
t_2error("arithmetic on non-integer: ",
ps_tok(op));
RETURN_BOOL("pe_type1", FALSE);
}
break;
case UAND_TOK:
(void) pe_islval(p1, UAND_TOK);
t = new_tnode();
t -> t_typtok = POINTER_TYPE;
t -> t_tsize = POINTER_SIZE;
t -> t_link = t1;
p -> n_cltype = t;
break;
case NOT_TOK:
p -> n_cltype = new_tnode();
break;
case PRE_INC_TOK:
case PRE_DEC_TOK:
case POST_INC_TOK:
case POST_DEC_TOK:
if (t1 -> t_typtok != INT_TYPE
&& t1 -> t_typtok != POINTER_TYPE) {
t_2error("nonscalar operand: ", ps_tok(op));
RETURN_BOOL("pe_type1", FALSE);
}
if (!pe_islval(p1, op)) {
RETURN_BOOL("pe_type1", FALSE);
}
if (t1 -> t_typtok == POINTER_TYPE &&
t1 -> t_link -> t_typtok == VOID_TYPE) {
t_2error(ps_tok(op), " on pointer to void");
}
break;
case USTAR_TOK:
if (t1 -> t_typtok == POINTER_TYPE ||
t1 -> t_typtok == ARRAY_TYPE) {
t1 = t1 -> t_link;
if (t1 == NULL) {
t_error("internal: pointer to no-type");
RETURN_BOOL("pe_type1", FALSE);
}
else {
p -> n_cltype = t1;
}
}
else {
t_error("indirection on non-pointer");
RETURN_BOOL("pe_type1", FALSE);
}
break;
default:
printf("unknown op %d\n", op);
fatal("pe_type1: unknown unary op");
}
RETURN_BOOL("pe_type1", TRUE);
}
/*
Set type of an expression involving a binary operator.
A type always gets attached to p, and the routine returns
FALSE if that type had to be made of whole cloth.
(If it is desired to have the made-up type be VOID instead
of INT, do it here, and don't change new_tnode!)
*/
static bool
pe_type2(register struct node * p)
{
register struct node *p1, *p2;
register struct type_node *t, *t1, *t2;
int op;
TRACEPB("pe_type2", printf("(%p)\n", p));
p1 = p -> n_arg1;
p2 = p -> n_arg2;
t1 = p1 -> n_cltype;
t2 = p2 -> n_cltype;
op = p -> n_type;
if (t1 == NULL || (t2 == NULL && op != CALL_TOK)) {
/* second arg of call is a list which presently has no type */
t_2error("internal: untyped operand of: ", ps_tok(op));
p -> n_cltype = new_tnode();
RETURN_BOOL("pe_type2", FALSE);
}
p -> n_cltype = t1;
/* this is the default return */
/* handle the various ops */
/* assignments continue on through for a post-check as well */
switch (op) {
case ASSN_TOK:
switch(t1 -> t_typtok) {
default:
t_error("non-assignable lvalue type: =");
RETURN_BOOL("pe_type2", FALSE);
case INT_TYPE:
case POINTER_TYPE:
;
}
if (!pd_taeq(t1, t2)) {
if (t1 -> t_typtok == POINTER_TYPE) {
if (pe_zcheck(p2)) {
/* it's ok */
}
else if (t2 -> t_typtok == POINTER_TYPE ||
t2 -> t_typtok == ARRAY_TYPE) {
t_warning("pointers to different objects: =");
TRACE("pe_type2", pr_type(t1);
pr_type(t2));
/* but proceed despite warning */
}
else {
t_error("type mismatch: =");
RETURN_BOOL("pe_type2", FALSE);
}
}
else {
if (t2 -> t_typtok == INT_TYPE &&
m_size(t1 -> t_mclass) == m_size(t2 -> t_mclass)) {
t_warning("type mismatch: =");
}
else {
t_error("type mismatch: =");
TRACEP("pe_type2",
pr_type(t1);
pr_type(t2);
);
RETURN_BOOL("pe_type2", FALSE);
}
}
}
/* fall out of switch to lvalue check */
break;
case PLUS_ASSN_TOK:
case MINUS_ASSN_TOK:
switch(t1 -> t_typtok) {
case INT_TYPE:
switch (t2 -> t_typtok) {
case POINTER_TYPE:
case ARRAY_TYPE:
t_3serr(NULL, "integer ", ps_tok(op), " pointer");
RETURN_BOOL("pe_type2", FALSE);
default:
t_2error("non-assignable type: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
case INT_TYPE:
if (!pd_teq(t1, t2)) {
t_2error("type mismatch: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
break;
}
break;
case POINTER_TYPE:
if (t1 -> t_link -> t_typtok == VOID_TYPE) {
t_2error(ps_tok(op), " into pointer to void");
}
switch (t2 -> t_typtok) {
case POINTER_TYPE:
case ARRAY_TYPE:
t_3serr(NULL, "pointer ", ps_tok(op), " pointer");
RETURN_BOOL("pe_type2", FALSE);
default:
t_2error("non-assignable type: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
case INT_TYPE:
break;
}
break;
default:
t_2error("non-assignable lvalue type: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
/* go do assignment check */
break;
case LSHIFT_ASSN_TOK:
case RSHIFT_ASSN_TOK:
if (t1 -> t_typtok != INT_TYPE || t2 -> t_typtok != INT_TYPE) {
t_2error("non-numeric assignment: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
break;
case AND_ASSN_TOK:
case DIV_ASSN_TOK:
case MOD_ASSN_TOK:
case OR_ASSN_TOK:
case STAR_ASSN_TOK:
case XOR_ASSN_TOK:
if (t1 -> t_typtok != INT_TYPE || t2 -> t_typtok != INT_TYPE) {
t_2error("non-numeric assignment: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
else if (!pd_teq(t1, t2)) {
t_2error("type mismatch: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
break; /* go do assignment check */
/* 6 relational operators and two boolean operators. */
case EQUAL_TOK:
case NE_TOK:
if (t1 -> t_typtok == INT_TYPE) {
p -> n_cltype = new_tnode();
if (pd_teq(t1, t2)) {
RETURN_BOOL("pe_type2", TRUE);
}
if (t2 -> t_typtok == INT_TYPE &&
m_size(t1 -> t_mclass) == m_size(t2 -> t_mclass)) {
t_warning("type mismatch: =");
RETURN_BOOL("pe_type2", TRUE);
}
else {
t_2error("type mismatch: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
}
/* FALLTHROUGH */
case GE_TOK:
case GT_TOK:
case LE_TOK:
case LT_TOK:
p -> n_cltype = new_tnode();
switch(t1 -> t_typtok) {
case INT_TYPE:
if (pd_teq(t1, t2)) {
RETURN_BOOL("pe_type2", TRUE);
}
else {
t_2error("type mismatch: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
case ARRAY_TYPE:
case POINTER_TYPE:
switch (t2 -> t_typtok) {
case ARRAY_TYPE:
case POINTER_TYPE:
if (!pd_taeq(t1, t2)) {
t_2warning("pointers to different objects: ", ps_tok(op));
}
RETURN_BOOL("pe_type2", TRUE);
case INT_TYPE:
t_2error("type mismatch: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
}
t_2error("comparison with nonscalar: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
case LAND_TOK:
case LOR_TOK:
p -> n_cltype = new_tnode();
switch(t1 -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
case ARRAY_TYPE:
switch(t2 -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
case ARRAY_TYPE:
RETURN_BOOL("pe_type2", TRUE);
}
}
t_2error("operand must be scalar: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
case COMMA_TOK:
p -> n_cltype = t2;
mark_noneed(p1);
RETURN_BOOL("pe_type2", TRUE);
/* 2 addition operators. */
case PLUS_TOK:
switch(t1 -> t_typtok) {
case INT_TYPE:
switch(t2 -> t_typtok) {
case INT_TYPE:
if (!pd_teq(t1, t2)) {
t_error("type mismatch: +");
RETURN_BOOL("pe_type2", FALSE);
}
break;
case POINTER_TYPE:
if (t2 -> t_link -> t_typtok == VOID_TYPE) {
t_error("addition to pointer to void");
}
case ARRAY_TYPE:
p -> n_cltype = t2;
break;
default:
t_error("integer + nonscalar");
RETURN_BOOL("pe_type2", FALSE);
}
break;
case POINTER_TYPE:
if (t1 -> t_link -> t_typtok == VOID_TYPE) {
t_error("addition to pointer to void");
}
case ARRAY_TYPE:
switch (t2 -> t_typtok) {
case INT_TYPE:
break;
case POINTER_TYPE:
case ARRAY_TYPE:
t_error("pointer + pointer");
RETURN_BOOL("pe_type2", FALSE);
default:
t_error("pointer + non-scalar");
RETURN_BOOL("pe_type2", FALSE);
}
break;
default:
t_error("non-scalar + something");
RETURN_BOOL("pe_type2", FALSE);
}
RETURN_BOOL("pe_type2", TRUE);
case MINUS_TOK:
switch (t1 -> t_typtok) {
case INT_TYPE:
switch (t2 -> t_typtok) {
case INT_TYPE:
if (!pd_teq(t1, t2)) {
t_error("type mismatch: -");
RETURN_BOOL("pe_type2", FALSE);
}
break;
case POINTER_TYPE:
t_error("integer - pointer");
RETURN_BOOL("pe_type2", FALSE);
default:
t_error("integer - nonscalar");
RETURN_BOOL("pe_type2", FALSE);
}
break;
case POINTER_TYPE:
if (t1 -> t_link -> t_typtok == VOID_TYPE) {
t_error("subtraction from pointer to void");
}
case ARRAY_TYPE:
switch (t2 -> t_typtok) {
case INT_TYPE:
break;
case POINTER_TYPE:
case ARRAY_TYPE:
/* pointer - pointer shall be long */
/* cast it if you want it truncated !!! */
p -> n_cltype = new_tnode();
p -> n_cltype -> t_mclass |= LONG_MOD;
break;
default:
t_error("pointer - non-scalar");
RETURN_BOOL("pe_type2", FALSE);
}
break;
default:
t_error("non-scalar - something");
RETURN_BOOL("pe_type2", FALSE);
}
RETURN_BOOL("pe_type2", TRUE);
/* 8 miscellaneous arithmetic operators. */
case AND_TOK:
case OR_TOK:
case XOR_TOK:
case MOD_TOK:
case STAR_TOK:
case DIV_TOK:
if (!pd_teq(t1, t2)) {
t_2error("type mismatch: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
/* FALLTHROUGH */
case LSHIFT_TOK:
case RSHIFT_TOK:
if (t1 -> t_typtok != INT_TYPE || t2 -> t_typtok != INT_TYPE) {
t_2error("non-numeric operand: ", ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
RETURN_BOOL("pe_type2", TRUE);
case CALL_TOK:
/* walk down function-returning link to get result type */
if (t1 -> t_typtok != FUNCTION_TYPE) {
t_error("function identifier isn't");
RETURN_BOOL("pe_type2", FALSE);
}
t = t1 -> t_link;
goto exit_check;
case ARRAY_TOK:
/* walk down the array-of link to get result type */
if (t1 -> t_typtok != POINTER_TYPE
&& t1 -> t_typtok != ARRAY_TYPE) {
t_error("subscript applied to non-array");
RETURN_BOOL("pe_type2", FALSE);
}
if (t2 -> t_typtok != INT_TYPE) {
t_error("array subscript not int");
}
t = t1 -> t_link;
goto exit_check;
case DOT_TOK:
if (t1 -> t_typtok == STRUCT_TYPE) {
if (t2 -> t_typtok != SELEMENT_TYPE) {
t_error("struct . non-structelement");
RETURN_BOOL("pe_type2", FALSE);
}
}
else if (t1 -> t_typtok == UNION_TYPE) {
if (t2 -> t_typtok != UELEMENT_TYPE) {
t_error("union . non-unionelement");
RETURN_BOOL("pe_type2", FALSE);
}
}
else {
t_error("non-struct/union . something");
RETURN_BOOL("pe_type2", FALSE);
}
t = t2 -> t_link;
goto exit_check;
case ARROW_TOK:
if (t1 -> t_typtok == ARRAY_TYPE) {
t_help("array -> something is bad form");
}
else if (t1 -> t_typtok != POINTER_TYPE) {
t_error("non-pointer -> something");
RETURN_BOOL("pe_type2", FALSE);
}
t = t1 -> t_link;
if (t == NULL) {
t_error("internal: pointer to undefined");
RETURN_BOOL("pe_type2", FALSE);
}
else if (t -> t_typtok == STRUCT_TYPE) {
if (t2 -> t_typtok != SELEMENT_TYPE) {
t_error("struct -> non-structelement");
RETURN_BOOL("pe_type2", FALSE);
}
}
else if (t1 -> t_typtok == UNION_TYPE) {
if (t2 -> t_typtok != UELEMENT_TYPE) {
t_error("union -> non-unionelement");
RETURN_BOOL("pe_type2", FALSE);
}
}
else {
t_warning("pointer on -> is not struct/union pointer");
}
t = t2 -> t_link;
exit_check:
if (t) {
p -> n_cltype = t;
}
else {
t_2error("internal: linked-NULL-type of operand of: ",
ps_tok(op));
RETURN_BOOL("pe_type2", FALSE);
}
RETURN_BOOL("pe_type2", TRUE);
default:
printf("unknown op %d\n", op);
fatal("pe_type2: unknown binop");
}
/* assignments fall out of the switch! */
/* check assignments */
if (!pe_islval(p1, op)) {
RETURN_BOOL("pe_type2", TRUE);
}
else if (t1 -> t_mclass & CONST_MOD) {
t_2error(ps_tok(op), " into lvalue of const type");
RETURN_BOOL("pe_type2", FALSE); /* ekr */
}
else if (t1 -> t_typtok == POINTER_TYPE &&
t2 -> t_typtok == POINTER_TYPE &&
t1 -> t_link -> t_mclass & CONST_MOD &&
!(t2 -> t_link -> t_mclass & CONST_MOD)) {
t_2warning(ps_tok(op),
" of pointer to non-const into pointer to const");
RETURN_BOOL("pe_type2", FALSE); /* ekr */
}
TICKX("pe_type2");
}
/*
Set type of an expression involving a ternary operator.
A type always gets attached to p, and the routine returns
FALSE if that type had to be made of whole cloth.
(If it is desired to have the made-up type be VOID instead
of INT, do it here, and don't change new_tnode!)
*/
static bool
pe_type3(register struct node * p)
{
register struct node *p1, *p2, *p3;
register struct type_node *t1, *t2, *t3;
TRACEPB("pe_type3", printf("(%p)\n", p));
p1 = p -> n_arg1;
p2 = p -> n_arg2;
p3 = p -> n_arg3;
t1 = p1 -> n_cltype;
t2 = p2 -> n_cltype;
t3 = p3 -> n_cltype;
p -> n_cltype = t2;
if (p1 == NULL || p3 == NULL) {
RETURN_BOOL("pe_type3", FALSE);
}
if (p -> n_type == QUESTION_TOK) {
if (!pd_t1eq(t2, t3)) {
if (t2 -> t_typtok == POINTER_TYPE &&
t3 -> t_typtok == POINTER_TYPE) {
t_warning("?: selects pointers to different types");
t_help("result of ?: is pointer to void");
t2 = new_tnode();
t2 -> t_typtok = VOID_TYPE;
t2 -> t_tsize = 0;
t3 = new_tnode();
t3 -> t_typtok = POINTER_TYPE;
t3 -> t_tsize = POINTER_SIZE;
t3 -> t_link = t2;
p -> n_cltype = t3;
}
else {
t_error("?: selects items of different types");
}
RETURN_BOOL("pe_type3", FALSE); /* disallow reduce */
}
if (t1) {
switch(t1 -> t_typtok) {
default:
t_error("switch in ?: is of unusable type");
RETURN_BOOL("pe_type3", FALSE);
case INT_TYPE:
case POINTER_TYPE:
;
}
}
else {
t_error("internal: untyped switch in ?:");
}
}
else {
printf("unknown op %d\n", p -> n_type);
fatal("pe_type3: unknown ternary op");
}
RETURN_BOOL("pe_type3", TRUE);
}
/*
Fold expressions involving a unary operator.
*/
static struct node *
pe_fold1(register struct node * p)
{
register struct node *p1;
register struct type_node *t, *t1;
register long value, val1;
register int op;
TICK("pe_fold1");
p1 = p -> n_arg1;
if ((op = p -> n_type) == CAST_TOK) {
if (!pe_sprim(p1) ||
(t = p -> n_cltype) == NULL ||
(t1 = p1 -> n_cltype) == NULL) {
return NULL;
}
/* do according to cast type itself */
switch (t -> t_typtok) {
case INT_TYPE:
switch (t1 -> t_typtok) {
case POINTER_TYPE:
case ARRAY_TYPE:
t1 -> t_typtok = INT_TYPE;
t1 -> t_mclass = UNSIGNED_MOD & LONG_MOD;
t1 -> t_tdim = 0;
t1 -> t_tsize = 4;
/* FALL_THROUGH */
case INT_TYPE:
pe_retype(t -> t_mclass, p1, op);
break;
default:
t_error("cast on nonscalar constant: shouldn't happen");
}
break;
case POINTER_TYPE:
case ARRAY_TYPE:
/* constant pointer is manifest; no warning */
p1 -> n_cltype = t;
break;
default:
t_error("cast into non-scalar");
}
t1 -> t_mclass |= CONST_MOD;
return p1;
}
else {
if (!pe_number(p1)) {
return NULL;
}
switch(op) {
case NOT_TOK:
p1 -> n_const = (long) !p1 -> n_const;
p1 -> n_cltype -> t_mclass &= ~ARITH_MODS;
return p1;
case UMINUS_TOK:
if (p1 -> n_cltype -> t_mclass & UNSIGNED_MOD) {
t_warning("negation of unsigned constant; result unsigned");
}
p1 -> n_const = - p1 -> n_const;
/* FALLTHROUGH */
case UPLUS_TOK:
return p1;
case TILDE_TOK:
p1 -> n_const = ~p1 -> n_const;
return p1;
}
}
return NULL;
}
/*
Fold an expression involving a binary operator.
Only arithmetic and relational operators may be folded.
The problem of assignment into a constant is handled by pe_type2().
*/
static struct node *
pe_fold2(register struct node * p)
{
union {
long sval;
unsigned long uval;
} value, val1, val2;
register int op, m1, m2;
register struct node *p1, *p2;
struct type_node *t1, *t2;
TICK("pe_fold2");
/* WARNING: it also might attempt to fold the subtraction
of two addresses */
TRACEP("pe_fold2", printf("op=%d, %s\n",
p -> n_type, ps_tok(p -> n_type)));
op = p -> n_type;
p1 = p -> n_arg1;
p2 = p -> n_arg2;
t1 = p1 -> n_cltype;
t2 = p2 -> n_cltype;
if (t1 == NULL || t2 == NULL) {
fatal("pe_fold2: untyped operand");
}
if (op == PLUS_TOK) {
if (pe_number(p1)) {
/*
NOTE: for the following multiplication, it
is unnecessary to distinguish between signed
and unsigned operands, since they all lead to
the same bit-pattern, which is added in the
same way to the pointer. That is, all effects
of operand signs lie outside the low 32 bits
and are therefore never extant. See note on
signed vs unsigned multiplication.
*/
if (t2 -> t_typtok != INT_TYPE && pe_sprim(p2)) {
TRACEP("pe_fold2", printf("fold pointer\n"));
p2 -> n_const +=
p1->n_const * (long) t2 -> t_link -> t_tsize;
return p2;
}
}
else if (pe_number(p2)) {
if (t1 -> t_typtok != INT_TYPE && pe_sprim(p1)) {
TRACEP("pe_fold2", printf("fold pointer\n"));
p1 -> n_const +=
p2->n_const * (long) t1 -> t_link -> t_tsize;
return p1;
}
}
}
/* massage constant types and short out certain constants */
if (!pe_number(p1)) {
if (pe_number(p2)) {
switch(op) {
case PLUS_TOK:
case PLUS_ASSN_TOK:
case MINUS_TOK:
case MINUS_ASSN_TOK:
if (p2 -> n_const == 0) {
return p1;
}
break;
case STAR_TOK:
case STAR_ASSN_TOK:
case DIV_TOK:
case DIV_ASSN_TOK:
if (p2 -> n_const == 1) {
return p1;
}
break;
case MOD_TOK:
if (p2 -> n_const == 1) {
p2 -> n_const = 0;
return p2;
}
break;
case LSHIFT_TOK:
case LSHIFT_ASSN_TOK:
case RSHIFT_TOK:
case RSHIFT_ASSN_TOK:
if (p2 -> n_const == 0) {
return p1;
}
break;
}
pe_massage(t1, p2, op);
}
return NULL;
}
else if (!pe_number(p2)) {
switch(op) {
case PLUS_TOK:
if (p1 -> n_const == 0) {
return p2;
}
break;
case MINUS_TOK:
/* CAUTION: assumption about unop_node and binop_node
similarity */
if (p1 -> n_const == 0) {
p -> n_type = UMINUS_TOK;
p -> n_arg1 = p2;
(void) pe_type1(p);
return p;
}
break;
case STAR_TOK:
if (p1 -> n_const == 1) {
return p2;
}
break;
case LSHIFT_TOK:
case RSHIFT_TOK:
if (p1 -> n_const == 0) {
return p1;
}
break;
}
if (!is_assnop(op)) {
pe_massage(t2, p1, op);
}
return NULL;
}
TRACEP("pe_fold2", printf("folding two constants\n"));
if (op == COMMA_TOK) {
t_warning("constant , constant");
return NULL;
}
/*
when folding two constants, use the K&R rules.
we choose to do this with constants because of a
variety of practical problems that arise otherwise
note that using a constant expression as a function
argument is a very dangerous business, expecially if
macros are involved, and it may be well to cast such
things explicitly; such casts raise warnings in C-Star
if the cast type is too narrow to hold the object
*/
if ((m1 = t1 -> t_mclass) != (m2 = t2 -> t_mclass)) {
if (m1 & LONG_MOD && !(m2 & LONG_MOD)) {
pe_retype(m1 | (m2 & UNSIGNED_MOD), p2, op);
m2 = t2 -> t_mclass;
}
else if (m2 & LONG_MOD && !(m1 & LONG_MOD)) {
pe_retype(m2 | (m1 & UNSIGNED_MOD), p1, op);
m1 = t1 -> t_mclass;
}
else if (m2 & CHAR_MOD && !(m1 & CHAR_MOD)) {
pe_retype(m1 | (m2 & UNSIGNED_MOD), p2, op);
m2 = t2 -> t_mclass;
}
else if (m1 & CHAR_MOD && !(m2 & CHAR_MOD)) {
pe_retype(m2 | (m1 & UNSIGNED_MOD), p1, op);
m1 = t1 -> t_mclass;
}
/* now they are both the same length */
if (m1 & UNSIGNED_MOD && !(m2 & UNSIGNED_MOD)) {
pe_retype(m1, p2, op);
m2 = m1;
}
else if (m2 & UNSIGNED_MOD && !(m1 & UNSIGNED_MOD)) {
pe_retype(m2, p1, op);
m1 = m2;
}
}
/* now they are standardly signed versus unsigned */
val1.sval = p1 -> n_const;
val2.sval = p2 -> n_const;
if (m1 & UNSIGNED_MOD) {
switch (op) {
case GE_TOK: value.sval = (long)(val1.uval >= val2.uval); break;
case GT_TOK: value.sval = (long)(val1.uval > val2.uval); break;
case LE_TOK: value.sval = (long)(val1.uval <= val2.uval); break;
case LT_TOK: value.sval = (long)(val1.uval < val2.uval); break;
case STAR_TOK: value.uval = val1.uval * val2.uval; break;
case DIV_TOK: if (val2.uval == 0) {
value.uval = 0;
t_error("division by zero: /");
}
else {
value.uval = val1.uval / val2.uval;
}
break;
case MOD_TOK: if (val2.uval == 0) {
t_error("division by zero: %");
value.uval = 0;
}
else {
value.uval = val1.uval % val2.uval;
}
break;
default:
goto sign_ed;
} /* end switch */
goto around;
} /* end if clause */
sign_ed:
switch (op) {
/* 6 relational operators. */
case GE_TOK: value.sval = (long)(val1.sval >= val2.sval); break;
case GT_TOK: value.sval = (long)(val1.sval > val2.sval); break;
case LE_TOK: value.sval = (long)(val1.sval <= val2.sval); break;
case LT_TOK: value.sval = (long)(val1.sval < val2.sval); break;
case EQUAL_TOK: value.sval = (long)(val1.sval == val2.sval); break;
case NE_TOK: value.sval = (long)(val1.sval != val2.sval); break;
/* 10 arithmetic operators. */
case LSHIFT_TOK: value.sval = val1.sval << val2.sval; break;
case RSHIFT_TOK: value.sval = val1.sval >> val2.sval; break;
case AND_TOK: value.sval = val1.sval & val2.sval; break;
case OR_TOK: value.sval = val1.sval | val2.sval; break;
case XOR_TOK: value.sval = val1.sval ^ val2.sval; break;
case PLUS_TOK: value.sval = val1.sval + val2.sval; break;
case MINUS_TOK: value.sval = val1.sval - val2.sval; break;
case STAR_TOK: value.sval = val1.sval * val2.sval; break;
case DIV_TOK: if (val2.sval == 0) {
value.sval = 0;
t_error("division by zero: /");
}
else {
value.sval = val1.sval / val2.sval;
}
break;
case MOD_TOK: if (val2.sval == 0) {
t_error("division by zero: %");
value.sval = 0;
}
else {
value.sval = val1.sval % val2.sval;
}
break;
default:
return NULL;
}
around:
/* Return pointer to updated constant node. */
p1 -> n_const = value.sval;
/* Fiddle with the result width */
switch (op) {
case GE_TOK:
case GT_TOK:
case LE_TOK:
case LT_TOK:
case EQUAL_TOK:
case NE_TOK:
t1 -> t_mclass &= ~ARITH_MODS;
break;
case AND_TOK:
case OR_TOK:
case XOR_TOK:
case PLUS_TOK:
case MINUS_TOK:
case STAR_TOK:
case DIV_TOK:
case MOD_TOK:
if (pe_oversize(m1, value.sval)) {
if (m1 & CHAR_MOD) {
m1 &= ~SIZE_MODS;
t1 -> t_tsize = INT_SIZE;
t_2warning("constant result is int: ",
ps_tok(p -> n_type));
}
else {
m1 &= ~SIZE_MODS;
m1 |= LONG_MOD;
t1 -> t_tsize = LONG_SIZE;
t_2warning("constant result is long: ",
ps_tok(p -> n_type));
}
}
t1 -> t_mclass = m1;
break;
}
return p1;
}
/*
t1 is a type and p2 is a manifest constant.
attach t1 to p2 in certain cases.
*/
void
pe_massage(register struct type_node *t1, register struct node *p2, int op)
{
TRACEPB("pe_massage", printf("(%p, %p, %d)\n", t1, p2, op));
TRACE("pe_massage",
pr_type(t1);
printf("<< %s >>\n",
ps_tok(op));
pr_type(p2 -> n_cltype);
printf("\n"));
switch(t1 -> t_typtok) {
case POINTER_TYPE:
TRACEP("pe_massage", printf("pointer <> %ld\n",
p2 -> n_const));
switch(op) {
case ASSN_TOK:
case EQUAL_TOK:
case NE_TOK:
/* in the case of constant zero, force a match */
if (p2 -> n_const == 0) {
TRACEP("pe_massage", printf(" substitute\n"));
p2 -> n_cltype = t1;
}
}
break;
case INT_TYPE:
switch(op) {
/*
shift-operators have no length constraints
and so they need not be massaged
*/
case GE_TOK:
case GT_TOK:
case LE_TOK:
case LT_TOK:
case EQUAL_TOK:
case NE_TOK:
case ASSN_TOK:
case PLUS_ASSN_TOK:
case MINUS_ASSN_TOK:
case AND_ASSN_TOK:
case OR_ASSN_TOK:
case XOR_ASSN_TOK:
case STAR_ASSN_TOK:
case DIV_ASSN_TOK:
case MOD_ASSN_TOK:
case AND_TOK:
case OR_TOK:
case XOR_TOK:
case PLUS_TOK:
case MINUS_TOK:
case STAR_TOK:
case DIV_TOK:
case MOD_TOK:
pe_retype(t1 -> t_mclass, p2, op);
break;
}
break;
}
TICKX("pe_massage");
}
/*
copy int mclass into int type of CONSTANT p2.
do not do this to declared items; their typenodes are NOT unique
raise various warnings.
*/
void
pe_retype(int mclass, register struct node *p2, int op)
{
register struct type_node *t2;
TRACEPB("pe_retype", printf("(%d, %p, %d)\n", mclass, p2, op));
TRACEP("pe_retype",
printf("across %s\n", ps_tok(op));
if(ps_tok(op) == NULL) {
printf("op=%d\n", op);
});
t2 = p2 -> n_cltype;
pe_cl_check(t2 -> t_mclass, mclass, p2 -> n_const, op);
t2 -> t_mclass &= ~ARITH_MODS;
t2 -> t_mclass |= mclass & ARITH_MODS;
t2 -> t_tsize = m_size(mclass);
TICKX("pe_retype");
}
/*
generate warnings pursuant to copying or changing a constant from one
mclass into another
*/
static void
pe_cl_check(int oldclass, int newclass, long value, int op)
{
register int o;
TRACEPB("pe_cl_check", printf("(%d, %d, %ld, %d)\n", oldclass, newclass, value, op));
if ( (newclass & UNSIGNED_MOD) &&
!(oldclass & UNSIGNED_MOD) && value < 0) {
t_2warning("negative constant converted to unsigned: ", ps_tok(op));
}
if (o = pe_oversize(newclass, value)) {
if (o == 1) {
if ( (newclass & CHAR_MOD) && (oldclass & CHAR_MOD) ) {
}
else {
t_2warning("positive constant becomes negative: ", ps_tok(op));
}
}
else {
t_2error("oversize constant: ", ps_tok(op));
}
}
TICKX("pe_cl_check");
}
/*
Return nonzero if an integer constant doesn't fit its mclass
*/
int
pe_oversize(int mclass, long value)
{
register long m;
TRACEPB("pe_oversize", printf("(%d, %ld)\n", mclass, value));
m = 0xFFFF0000L;
if (mclass & LONG_MOD) {
m = 0;
}
else if (mclass & CHAR_MOD) {
m = 0xFFFFFF00L;
}
if ((value & m) != 0 && (~value & m) != 0 ) {
/* constant won't fit, period */
RETURN_INT("pe_oversize", 2);
}
if (!(mclass & UNSIGNED_MOD)) {
/* RIGHT shift with negative-sign insertion */
m >>= 1;
m |= 0x80000000L;
if ((value & m) != 0 && (~value & m) != 0 ) {
/* unsigned overflows to negative */
RETURN_INT("pe_oversize", 1);
}
}
RETURN_INT("pe_oversize", 0);
}
/*
Return the size of a manifest numeric constant; or else 0 if
it's not.
*/
int
pe_number(struct node * p)
{
register struct type_node * t;
TRACEPB("pe_number", printf("(%p)\n", p));
if (p == NULL || p -> n_type != ID_TOK) {
RETURN_INT("pe_number", 0);
}
if (p -> n_mode || p -> n_cid || p -> n_reg1) {
RETURN_INT("pe_number", 0);
}
if (t = p -> n_cltype) {
if (t -> t_typtok == INT_TYPE) {
RETURN_INT("pe_number", (int) t -> t_tsize);
}
}
RETURN_INT("pe_number", 0);
}
/*
Return the size of a manifest numeric constant; or else 0 if
it's not.
*/
static int
pe_sprim(struct node * p)
{
register struct type_node * t;
TRACEPB("pe_sprim", printf("(%p)\n", p));
if (p == NULL || p -> n_type != ID_TOK) {
RETURN_INT("pe_sprim", 0);
}
if (p -> n_mode || p -> n_cid || p -> n_reg1) {
RETURN_INT("pe_sprim", 0);
}
if (t = p -> n_cltype) {
switch(t -> t_typtok) {
case INT_TYPE:
case POINTER_TYPE:
case ARRAY_TYPE:
RETURN_INT("pe_sprim", (int) t -> t_tsize);
}
}
RETURN_INT("pe_sprim", 0);
}
/*
Parse a (syntactical) primitive and return a pointer.
Return a pointer to a suitable node.
Items treated as primitives are:
identifier
constant (including sizeof)
Dn, An
*/
static struct node *
pe_prim(void)
{
register struct node *p;
register struct st_node *id;
register struct type_node *t, *t1;
TRACEPB("pe_prim", printf("called on t_type %d\n",t_type));
switch (t_type) {
case INT_TOK:
case LONG_TOK:
case CHAR_TOK:
case K_SIZEOF:
case STRING_TOK:
p = pe_cprim();
break;
case CC_TOK:
case ID_TOK:
TRACEP("pe_prim", printf("id, subtype %d\n", t_subtype));
p = new_pnode(sizeof(struct loc_node));
p -> n_reg1 = real_reg(t_subtype);
id = ast_lookup(t_symbol);
if (id == NULL) {
t = new_tnode();
id = rst_enter(t_symbol, t, NULL_CLASS);
get_token();
if (t_type == LPAREN_TOK && t_subtype == 0) {
/* assume it's a function name */
/* implicit declaration */
t1 = new_tnode();
t1 -> t_typtok = FUNCTION_TYPE;
t1 -> t_tsize = 0;
t1 -> t_link = t;
id -> st_type = t1;
id -> st_sclass = CODE_CLASS;
}
else if (t_subtype == 0) {
t_2error("undefined variable: ", id -> st_name);
}
else {
t_2error("undefined register: ", id -> st_name);
}
}
else {
get_token();
}
p -> n_cltype = id -> st_type;
if (p -> n_reg1 == 0) {
p -> n_cid = id; /* points to symbol table entry */
}
break;
default:
need(NULL_TOK);
p = NULL;
}
RETURN_PTR("pe_prim", p);
}
/*
Parse a primitive constant.
This must EITHER
return something
OR
flag t_error
*/
static struct node *
pe_cprim(void)
{
register struct node * p;
register struct type_node *t, *t1;
register struct st_node *id;
register unsigned long len;
TICKB("pe_cprim");
t = new_tnode();
t -> t_mclass |= CONST_MOD;
p = new_pnode(sizeof(struct loc_node));
p -> n_type = ID_TOK;
p -> n_cltype = t;
TRACE("pe_cprim", printf("loc_node = %p\n", p));
switch(t_type) {
case INT_TOK:
TRACEP("pe_cprim",
printf("short integer %ld 0x%lx\n",
t_value, t_value));
p -> n_const = t_value;
if (p -> n_const > INT_MAX || p -> n_const < - INT_MAX - 1) {
/*
this warning is especially important in function
calls if ints don't default to long size,
which they don't unless some changes are made
*/
t_help("constant taken as long");
t -> t_mclass |= LONG_MOD;
t -> t_tsize = LONG_SIZE;
}
get_token();
break;
case LONG_TOK:
TRACEP("pe_cprim",
printf("long integer %ld 0x%lx\n",
t_value, t_value));
p -> n_const = t_value;
t -> t_mclass |= LONG_MOD;
t -> t_tsize = LONG_SIZE;
get_token();
break;
case CHAR_TOK:
TRACEP("pe_cprim",
printf("char (byte) %ld 0x%lx\n",
t_value, t_value));
p -> n_const = t_value;
t -> t_typtok = INT_TYPE;
t -> t_mclass |= (CHAR_MOD | UNSIGNED_MOD);
t -> t_tsize = 1;
get_token();
break;
case K_SIZEOF:
p -> n_const = (long) pe_sizeof();
if (p -> n_const > INT_MAX) {
t_help("result of sizeof is long");
t -> t_mclass |= LONG_MOD;
t -> t_tsize = LONG_SIZE;
}
break;
case STRING_TOK:
/*
NOTE: ANSI says such a string shouldn't be
CONST. We may need to provide such
an option eventually.
*/
t -> t_typtok = INT_TYPE;
t -> t_mclass |= CHAR_MOD | CONST_MOD;
t -> t_tsize = 1;
t1 = new_tnode();
t1 -> t_typtok = ARRAY_TYPE;
t1 -> t_link = t;
t1 -> t_mclass |= CONST_MOD;
p -> n_cltype = t1;
/*
now make up an internal label. treat the string
as a static global in order to get the aliasing right
*/
p -> n_cid = id = rst_enter(str_name(), t1, STATICG_CLASS);
id -> st_alias = id -> st_name;
id -> st_iniz = new_iblock(1L);
len = (unsigned long) str_val(t_symbol);
id -> st_iniz -> idim = t1 -> t_tdim = t1 -> t_tsize = len;
id -> st_iniz -> idata[0] . ipt =
chr_salloc(t_symbol, (int) len);
id -> st_iniz -> itype = ISTRA_DEC;
t = new_tnode();
t -> t_typtok = DELEMENT_TYPE;
t -> t_parent = p -> n_cid;
t -> t_tsize = t1 -> t_tsize;
t -> t_link = t1;
if (intrn_decl) {
intrn_ptr -> t_list = t;
}
else {
intrn_decl = t;
}
intrn_ptr = t;
get_token();
break;
default:
t_2error("internal: pe_cprim: called with bad type at: ",
t_symbol);
}
RETURN_PTR("pe_cprim", p);
}
/*
Return the RESULT of a sizeof expression; a number, not a node.
*/
static unsigned long
pe_sizeof(void)
{
register struct node * p;
register struct type_node *t;
register unsigned long size;
TICKB("pe_sizeof");
get_token(); /* eat the K_SIZEOF */
need(LPAREN_TOK);
if ((t = pd_cast()) != NULL) {
size = t -> t_tsize;
if (size == 0) {
t_error("sizeof returns zero");
}
}
else {
p = pe_expr1(TRUE);
if (p == NULL) {
t_error("sizeof has no argument");
size = 0;
}
else if ( (t = p -> n_cltype) == NULL) {
printf("pe_sizeof: internal: no type");
size = 0;
}
else {
size = t -> t_tsize;
if (size == 0) {
t_error("sizeof returns zero");
}
}
}
need(RPAREN_TOK);
RETURN_ULONG("pe_sizeof", size);
}