* Copyright (c) 1980 The Regents of the University of California.
* %sccs.include.redist.c%
static char sccsid
[] = "@(#)conv.c 5.2 (Berkeley) %G%";
* Convert a p1 into a p2.
* Mostly used for different
* length integers and "to real" conversions.
if (p1
== NLNIL
|| p2
== NLNIL
)
switch (width(p1
) - width(p2
)) {
* p1 and p2 are compatible
* types for an assignment like
* context, i.e. value parameters,
* indicies for 'in', etc.
if (c2
== TINT
&& divflg
== FALSE
&& t
!= TR_NIL
) {
c1
= classify(rvalue(t
, NLNIL
, RREQ
));
error("Type clash: real is incompatible with integer");
cerror("This resulted because you used '/' which always returns real rather");
cerror("than 'div' which divides integers and returns integers");
if (scalar(p1
) != scalar(p2
)) {
derror("Type clash: non-identical scalar types");
if (width(p1
) != width(p2
)) {
derror("Type clash: unequal length strings");
derror("Type clash: files not allowed in this context");
derror("Type clash: non-identical %s types", clnames
[c1
]);
if (p1
->nl_flags
& NFILES
) {
derror("Type clash: %ss with file components not allowed in this context", clnames
[c1
]);
derror("Type clash: %s is incompatible with %s", clnames
[c1
], clnames
[c2
]);
* Rangechk generates code to
* check if the type p on top
* of the stack is in range for
* assignment to a variable
* When op is 1 we are checking length
* 4 numbers against length 2 bounds,
* and adding it to the opcode forces
* generation of appropriate tests.
op
= wq
!= wrp
&& (wq
== 4 || wrp
== 4);
if (rp
->class == TYPE
|| rp
->class == CRANGE
)
(void) put(3, O_RANG2
+op
, ( short ) rp
->range
[0],
(void) put(3, O_RANG4
+op
, rp
->range
[0], rp
->range
[1] );
(void) put(3, O_RANG2
+op
,( short ) rp
->range
[0],
(void) put(3, O_RANG4
+op
,rp
->range
[0],
if (rp
!= nl
+T2INT
&& rp
!= nl
+T4INT
)
(void) put(3, O_RANG2
+op
,( short ) rp
->range
[0],
* Range whose lower bounds are
* zero can be treated as scalars.
(void) put(2, O_RSNG2
+op
, ( short ) rp
->range
[1]);
(void) put( 2 , O_RSNG4
+op
, rp
->range
[1]);
* pc uses precheck() and postcheck().
* if type p requires a range check,
* then put out the name of the checking function
* for the beginning of a function call which is completed by postcheck.
* (name1 is for a full check; name2 assumes a lower bound of zero)
precheck( p
, name1
, name2
)
if ( p
-> class == TYPE
) {
putleaf( PCC_ICON
, 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN
| PCCT_INT
, PCCTM_PTR
)
putleaf( PCC_ICON
, 0 , 0 ,
PCCM_ADDTYPE( PCCTM_FTN
| PCCT_INT
, PCCTM_PTR
),
p
-> range
[0] != 0 ? name1
: name2
);
* how could a scalar ever be out of range?
* if type p requires a range check,
* then put out the rest of the arguments of to the checking function
* a call to which was started by precheck.
* the first argument is what is being rangechecked (put out by rvalue),
* the second argument is the lower bound of the range,
* the third argument is the upper bound of the range.
if ( need
-> class == TYPE
) {
switch ( need
-> class ) {
if ( need
!= nl
+ T4INT
) {
sconv(p2type(have
), PCCT_INT
);
if (need
-> range
[0] != 0 ) {
putleaf( PCC_ICON
, (int) need
-> range
[0] , 0 , PCCT_INT
,
putop( PCC_CM
, PCCT_INT
);
putleaf( PCC_ICON
, (int) need
-> range
[1] , 0 , PCCT_INT
,
putop( PCC_CM
, PCCT_INT
);
putop( PCC_CALL
, PCCT_INT
);
sconv(PCCT_INT
, p2type(have
));
sconv(p2type(have
), PCCT_INT
);
putRV(p
->symbol
, (p
->nl_block
& 037), p
->value
[0],
p
->extra_flags
, p2type( p
) );
putop( PCC_CM
, PCCT_INT
);
putRV(p
->symbol
, (p
->nl_block
& 037), p
->value
[0],
p
->extra_flags
, p2type( p
) );
putop( PCC_CM
, PCCT_INT
);
putop( PCC_CALL
, PCCT_INT
);
sconv(PCCT_INT
, p2type(have
));
double *dp
= ((double *) dub
);
long *lp
= ((long *) dub
);
newfp
[0] = dub
[0] & 0100000;
exp
= ((dub
[0] >> 7) & 0377) - 0200;
newfp
[0] |= (mant
>> 17) & 077777;
newfp
[1] |= (((int) (mant
>> 1)) & 0177400) | (exp
<< 1);