/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)rval.c 1.3 %G%";
long mathop
[] = { P2MUL
, P2PLUS
, P2MINUS
};
char *setop
[] = { "_MULT" , "_ADDT" , "_SUBT" };
* Rvalue - an expression.
* Contype is the type that the caller would prefer, nand is important
* if constant sets or constant strings are involved, the latter
* because of string padding.
* required is a flag whether an lvalue or an rvalue is required.
* only VARs and structured things can have gt their lvalue this way.
rvalue(r
, contype
, required
)
register struct nl
*p
, *p1
;
* Pick up the name of the operation
* for future error messages.
* The root of the tree tells us what sort of expression we have.
putleaf( P2ICON
, 0 , 0 , P2PTR
|P2UNDEF
, 0 );
* Function call with arguments.
if (p
== NIL
|| p
->class == BADUSE
)
put(2, O_RV8
| bn
<< 8+INDX
, p
->value
[0]);
put(2, O_RV4
| bn
<< 8+INDX
, p
->value
[0]);
put(2, O_RV2
| bn
<< 8+INDX
, p
->value
[0]);
put(2, O_RV1
| bn
<< 8+INDX
, p
->value
[0]);
put(3, O_RV
| bn
<< 8+INDX
, p
->value
[0], w
);
if ( required
== RREQ
) {
putRV( p
-> symbol
, bn
, p
-> value
[0]
putLV( p
-> symbol
, bn
, p
-> value
[0]
* might consider a rvalue.
q
= lvalue(r
, NOFLAGS
, LREQ
);
if ( required
== RREQ
) {
putop( P2UNARY P2MUL
, p2type( q
) );
error("%s is a constant and cannot be qualified", r
[2]);
* Find the size of the string
if (contype
!= NIL
&& !opt('s')) {
if (width(contype
) < c
&& classify(contype
) == TSTR
) {
error("Constant string too long");
put( 2 + (sizeof(char *)/sizeof(short))
putCONG( cp1
, c
, required
);
* Define the string temporarily
* so later people can know its
put(2, O_CONC
, p
->value
[0]);
putleaf( P2ICON
, p
-> value
[0] , 0
* Every other kind of constant here
put(2, O_CON4
, p
->range
[0]);
putleaf( P2ICON
, p
-> range
[0] , 0
put(2, O_CON2
, ( short ) p
->range
[0]);
* make short constants ints
putleaf( P2ICON
, (short) p
-> range
[0]
put(2, O_CON1
, p
->value
[0]);
* make char constants ints
putleaf( P2ICON
, p
-> value
[0] , 0
* Function call with no arguments.
error("Can't qualify a function result value");
return (funccod((int *) r
));
error("Type names (e.g. %s) allowed only in declarations", p
->symbol
);
error("Procedure %s found where expression required", p
->symbol
);
if ( precset( r
, contype
, &csetd
) ) {
if ( csetd
.csettype
== NIL
) {
put( 2, O_PUSH
, -width(csetd
.csettype
));
setran( ( csetd
.csettype
) -> type
);
put( 2, O_CON24
, set
.uprbp
);
put( 2, O_CON24
, set
.lwrb
);
put( 2, O_CTTOT
, 5 + csetd
.singcnt
+ 2 * csetd
.paircnt
);
if ( precset( r
, contype
, &csetd
) ) {
if ( csetd
.csettype
== NIL
) {
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
* allocate a temporary and use it
sizes
[ cbn
].om_off
-= lwidth( csetd
.csettype
);
tempoff
= sizes
[ cbn
].om_off
;
putlbracket( ftnno
, -tempoff
);
if ( tempoff
< sizes
[ cbn
].om_max
) {
sizes
[ cbn
].om_max
= tempoff
;
putLV( 0 , cbn
, tempoff
, P2PTR
|P2STRTY
);
setran( ( csetd
.csettype
) -> type
);
putleaf( P2ICON
, set
.lwrb
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
putleaf( P2ICON
, set
.uprbp
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
q
= rvalue(r
[2], NIL
, RREQ
);
error("Operand of %s must be integer or real, not %s", opname
, nameof(q
));
put(1, O_NEG2
+ (width(q
) >> 2));
putop( P2UNARY P2MINUS
, p2type( q
) );
return (isa(q
, "d") ? q
: nl
+T4INT
);
q
= rvalue(r
[2], NIL
, RREQ
);
error("not must operate on a Boolean, not %s", nameof(q
));
p
= rvalue(r
[2], NIL
, RREQ
);
p1
= rvalue(r
[3], NIL
, RREQ
);
if (p
== NIL
|| p1
== NIL
)
error("Left operand of %s must be Boolean, not %s", opname
, nameof(p
));
error("Right operand of %s must be Boolean, not %s", opname
, nameof(p1
));
put(1, r
[0] == T_AND
? O_AND
: O_OR
);
* note the use of & and | rather than && and ||
* to force evaluation of all the expressions.
putop( r
[ 0 ] == T_AND
? P2AND
: P2OR
, P2INT
);
p
= rvalue(r
[2], NIL
, RREQ
);
p1
= rvalue(r
[3], NIL
, RREQ
);
* force these to be doubles for the divide
p
= rvalue( r
[ 2 ] , NIL
, RREQ
);
if ( isnta( p
, "d" ) ) {
putop( P2SCONV
, P2DOUBLE
);
p1
= rvalue( r
[ 3 ] , NIL
, RREQ
);
if ( isnta( p1
, "d" ) ) {
putop( P2SCONV
, P2DOUBLE
);
if (p
== NIL
|| p1
== NIL
)
error("Left operand of / must be integer or real, not %s", nameof(p
));
error("Right operand of / must be integer or real, not %s", nameof(p1
));
return gen(NIL
, r
[0], width(p
), width(p1
));
putop( P2DIV
, P2DOUBLE
);
* If the context hasn't told us
* the type and a constant set is
* present on the left we need to infer
* the type from the right if possible
* before generating left side code.
if (contype
== NIL
&& (rt
= r
[2]) != NIL
&& rt
[1] == SAWCON
) {
contype
= rvalue(r
[3], NIL
, RREQ
);
p
= rvalue(r
[2], contype
, RREQ
);
p1
= rvalue(r
[3], p
, RREQ
);
if (p
== NIL
|| p1
== NIL
)
if (isa(p
, "id") && isa(p1
, "id"))
return (gen(NIL
, r
[0], width(p
), width(p1
)));
if (isa(p
, "t") && isa(p1
, "t")) {
error("Set types of operands of %s must be identical", opname
);
gen(TSET
, r
[0], width(p
), 0);
* the second pass can't do
* long op double or double op long
* so we have to know the type of both operands
* also, it gets tricky for sets, which are done
p1
= rvalue( r
[ 3 ] , contype
, RREQ
);
if ( isa( p1
, "id" ) ) {
p
= rvalue( r
[ 2 ] , contype
, RREQ
);
if ( ( p
== NIL
) || ( p1
== NIL
) ) {
if ( isa( p
, "i" ) && isa( p1
, "d" ) ) {
putop( P2SCONV
, P2DOUBLE
);
p1
= rvalue( r
[ 3 ] , contype
, RREQ
);
if ( isa( p
, "d" ) && isa( p1
, "i" ) ) {
putop( P2SCONV
, P2DOUBLE
);
if ( isa( p
, "d" ) || isa( p1
, "d" ) ) {
putop( mathop
[ r
[0] - T_MULT
] , ctype
);
, ADDTYPE( ADDTYPE( P2PTR
| P2STRTY
, P2FTN
)
, setop
[ r
[0] - T_MULT
] );
* allocate a temporary and use it
sizes
[ cbn
].om_off
-= lwidth( p1
);
tempoff
= sizes
[ cbn
].om_off
;
putlbracket( ftnno
, -tempoff
);
if ( tempoff
< sizes
[ cbn
].om_max
) {
sizes
[ cbn
].om_max
= tempoff
;
putLV( 0 , cbn
, tempoff
, P2PTR
|P2STRTY
);
p
= rvalue( r
[2] , p1
, LREQ
);
putop( P2LISTOP
, P2INT
);
if ( p
== NIL
|| p1
== NIL
) {
p1
= rvalue( r
[3] , p
, LREQ
);
error("Set types of operands of %s must be identical", opname
);
putop( P2LISTOP
, P2INT
);
putleaf( P2ICON
, lwidth( p1
) / sizeof( long ) , 0
putop( P2LISTOP
, P2INT
);
putop( P2CALL
, P2PTR
| P2STRTY
);
if ( isnta( p1
, "idt" ) ) {
* find type of left operand for error message.
p
= rvalue( r
[2] , contype
, RREQ
);
* don't give spurious error messages.
if ( p
== NIL
|| p1
== NIL
) {
error("Left operand of %s must be integer, real or set, not %s", opname
, nameof(p
));
error("Right operand of %s must be integer, real or set, not %s", opname
, nameof(p1
));
error("Cannot mix sets with integers and reals as operands of %s", opname
);
p
= rvalue(r
[2], NIL
, RREQ
);
p1
= rvalue(r
[3], NIL
, RREQ
);
if (p
== NIL
|| p1
== NIL
)
error("Left operand of %s must be integer, not %s", opname
, nameof(p
));
error("Right operand of %s must be integer, not %s", opname
, nameof(p1
));
return (gen(NIL
, r
[0], width(p
), width(p1
)));
putop( r
[ 0 ] == T_DIV
? P2DIV
: P2MOD
, P2INT
);
* Since there can be no, a priori, knowledge
* of the context type should a constant string
* or set arise, we must poke around to find such
* a type if possible. Since constant strings can
* always masquerade as identifiers, this is always
p1
= rvalue(r
[3], NIL
, RREQ
);
if (p1
== nl
+TSET
|| p1
->class == STR
) {
* For constant strings we want
* the longest type so as to be
* able to do padding (more importantly
* avoiding truncation). For clarity,
* we get this length here.
p
= rvalue(r
[2], NIL
, RREQ
);
if (p1
== nl
+TSET
|| width(p
) > width(p1
))
* Now we generate code for
* the operands of the relational
p
= rvalue(r
[2], contype
, RREQ
);
p1
= rvalue(r
[3], p
, RREQ
);
if ( c1
== TSET
|| c1
== TSTR
|| c1
== TREC
) {
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
, c1
== TSET
? relts
[ r
[0] - T_EQ
]
: relss
[ r
[0] - T_EQ
] );
* for [] and strings, comparisons are done on
* the maximum width of the two sides.
* for other sets, we have to ask the left side
* what type it is based on the type of the right.
* (this matters for intsets).
if ( p1
== nl
+ TSET
|| c1
== TSTR
) {
p
= rvalue( r
[ 2 ] , NIL
, LREQ
);
|| lwidth( p
) > lwidth( p1
) ) {
p
= rvalue( r
[ 2 ] , contype
, LREQ
);
* put out the width of the comparison.
putleaf( P2ICON
, lwidth( contype
) , 0 , P2INT
, 0 );
* and the left hand side,
* for sets, strings, records
p
= rvalue( r
[ 2 ] , contype
, LREQ
);
putop( P2LISTOP
, P2INT
);
p1
= rvalue( r
[ 3 ] , p
, LREQ
);
putop( P2LISTOP
, P2INT
);
* the easy (scalar or error) case
p
= rvalue( r
[ 2 ] , contype
, RREQ
);
* since the second pass can't do
* long op double or double op long
* we may have to do some coercing.
if ( isa( p
, "i" ) && isa( p1
, "d" ) )
putop( P2SCONV
, P2DOUBLE
);
p1
= rvalue( r
[ 3 ] , p
, RREQ
);
if ( isa( p
, "d" ) && isa( p1
, "i" ) )
putop( P2SCONV
, P2DOUBLE
);
putop( relops
[ r
[0] - T_EQ
] , P2INT
);
if (nocomp(c
) || nocomp(c1
))
if (c1
!= TINT
&& c1
!= TDOUBLE
)
if (scalar(p
) != scalar(p1
))
if (r
[0] != T_EQ
&& r
[0] != T_NE
) {
error("%s not allowed on records - only allow = and <>" , opname
);
if (c1
!= TPTR
&& c1
!= TNIL
)
if (r
[0] != T_EQ
&& r
[0] != T_NE
) {
error("%s not allowed on pointers - only allow = and <>" , opname
);
if (width(p
) != width(p1
)) {
error("Strings not same length in %s comparison", opname
);
return (gen(g
, r
[0], width(p
), width(p1
)));
error("%ss and %ss cannot be compared - operator was %s", clnames
[c
], clnames
[c1
], opname
);
error("%s types must be identical in comparisons - operator was %s", clnames
[c1
], opname
);
if (rt
!= NIL
&& rt
[0] == T_CSET
) {
precset( rt
, NIL
, &csetd
);
error("... in [] makes little sense, since it is always false!");
p1
= stkrval(r
[3], NIL
, RREQ
);
if (rt
!= NIL
&& rt
[0] == T_CSET
) {
if ( precset( rt
, NIL
, &csetd
) ) {
if ( csetd
.csettype
!= nl
+ TSET
) {
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
error("... in [] makes little sense, since it is always false!");
putleaf( P2ICON
, 0 , 0 , P2INT
, 0 );
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
p1
= rvalue(r
[3], NIL
, LREQ
);
p
= stkrval(r
[2], NIL
, RREQ
);
if (p
== NIL
|| p1
== NIL
)
error("Right operand of 'in' must be a set, not %s", nameof(p1
));
if (incompat(p
, p1
->type
, r
[2])) {
cerror("Index type clashed with set component type for 'in'");
if (rt
== NIL
|| csetd
.comptime
)
put(4, O_IN
, width(p1
), set
.lwrb
, set
.uprbp
);
put(2, O_INCT
, 3 + csetd
.singcnt
+ 2*csetd
.paircnt
);
if ( rt
== NIL
|| rt
[0] != T_CSET
) {
putleaf( P2ICON
, set
.lwrb
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
putleaf( P2ICON
, set
.uprbp
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
p1
= rvalue( r
[3] , NIL
, LREQ
);
putop( P2LISTOP
, P2INT
);
} else if ( csetd
.comptime
) {
putleaf( P2ICON
, set
.lwrb
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
putleaf( P2ICON
, set
.uprbp
, 0 , P2INT
, 0 );
putop( P2LISTOP
, P2INT
);
postcset( r
[3] , &csetd
);
putop( P2LISTOP
, P2INT
);
postcset( r
[3] , &csetd
);
if (f
> MAXINT
|| f
< MININT
) {
error("Constant too large for this implementation");
put(2, O_CON2
, ( short ) l
);
* short constants are ints
putleaf( P2ICON
, l
, 0 , P2INT
, 0 );
putleaf( P2ICON
, l
, 0 , P2INT
, 0 );
* A floating point number
put(2, O_CON8
, atof(r
[2]));
* Constant strings. Note that constant characters
* are constant strings of length one; there is
* no constant string of length one.
putleaf( P2ICON
, cp
[0] , 0 , P2CHAR
, 0 );
error("record comparison is non-standard");
error("%ss may not participate in comparisons", clnames
[c
]);
* this is sort of like gconst, except it works on expression trees
* rather than declaration trees, and doesn't give error messages for
* as a side effect this fills in the con structure that gconst uses.
* this returns TRUE or FALSE.
* cn[2] is nil if error recovery generated a T_STRNG
if (cn
== NIL
|| cn
[2] == NIL
)
if (np
== NIL
|| np
->class != CONST
) {
switch (classify(np
->type
)) {
con
.crval
= np
->range
[0];
con
.cival
= np
->value
[0];
con
.crval
= a8tol(cn
[2]);
if (con
.crval
> MAXINT
|| con
.crval
< MININT
) {
derror("Constant too large for this implementation");
if (isnta(con
.ctype
, "id")) {
derror("%s constants cannot be signed", nameof(con
.ctype
));