projects
/
unix-history
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
tags
|
clone url
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
BSD 4_3 release
[unix-history]
/
usr
/
src
/
ucb
/
pascal
/
src
/
stkrval.c
diff --git
a/usr/src/ucb/pascal/src/stkrval.c
b/usr/src/ucb/pascal/src/stkrval.c
index
328c944
..
1352f41
100644
(file)
--- a/
usr/src/ucb/pascal/src/stkrval.c
+++ b/
usr/src/ucb/pascal/src/stkrval.c
@@
-1,6
+1,12
@@
-/* Copyright (c) 1979 Regents of the University of California */
+/*
+ * Copyright (c) 1980 Regents of the University of California.
+ * All rights reserved. The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.
+ */
-static char sccsid[] = "@(#)stkrval.c 1.7 2/9/83";
+#ifndef lint
+static char sccsid[] = "@(#)stkrval.c 5.1 (Berkeley) 6/5/85";
+#endif not lint
#include "whoami.h"
#include "0.h"
#include "whoami.h"
#include "0.h"
@@
-8,8
+14,9
@@
static char sccsid[] = "@(#)stkrval.c 1.7 2/9/83";
#include "opcode.h"
#include "objfmt.h"
#ifdef PC
#include "opcode.h"
#include "objfmt.h"
#ifdef PC
-# include
"pcops.h"
+# include
<pcc.h>
#endif PC
#endif PC
+#include "tree_ty.h"
/*
* stkrval Rvalue - an expression, and coerce it to be a stack quantity.
/*
* stkrval Rvalue - an expression, and coerce it to be a stack quantity.
@@
-26,7
+33,7
@@
static char sccsid[] = "@(#)stkrval.c 1.7 2/9/83";
*/
struct nl *
stkrval(r, contype , required )
*/
struct nl *
stkrval(r, contype , required )
- register
int
*r;
+ register
struct tnode
*r;
struct nl *contype;
long required;
{
struct nl *contype;
long required;
{
@@
-34,36
+41,40
@@
stkrval(r, contype , required )
register struct nl *q;
register char *cp, *cp1;
register int c, w;
register struct nl *q;
register char *cp, *cp1;
register int c, w;
-
int *
*pt;
+
struct tnode
*pt;
long l;
long l;
- double f;
+ union
+ {
+ double pdouble;
+ long plong[2];
+ }f;
- if (r == NIL)
- return (NIL);
+ if (r ==
TR_
NIL)
+ return (N
LN
IL);
if (nowexp(r))
if (nowexp(r))
- return (NIL);
+ return (N
LN
IL);
/*
* The root of the tree tells us what sort of expression we have.
*/
/*
* The root of the tree tells us what sort of expression we have.
*/
- switch (r
[0]
) {
+ switch (r
->tag
) {
/*
* The constant nil
*/
case T_NIL:
# ifdef OBJ
/*
* The constant nil
*/
case T_NIL:
# ifdef OBJ
- put(2, O_CON14, 0);
+
(void)
put(2, O_CON14, 0);
# endif OBJ
# ifdef PC
# endif OBJ
# ifdef PC
- putleaf( P
2ICON , 0 , 0 , P2INT ,
0 );
+ putleaf( P
CC_ICON , 0 , 0 , PCCT_INT , (char *)
0 );
# endif PC
return (nl+TNIL);
case T_FCALL:
case T_VAR:
# endif PC
return (nl+TNIL);
case T_FCALL:
case T_VAR:
- p = lookup(r
[2]
);
- if (p == NIL || p->class == BADUSE)
- return (NIL);
+ p = lookup(r
->var_node.cptr
);
+ if (p == N
LN
IL || p->class == BADUSE)
+ return (N
LN
IL);
switch (p->class) {
case VAR:
/*
switch (p->class) {
case VAR:
/*
@@
-72,20
+83,20
@@
stkrval(r, contype , required )
* the rvalue by a
* stklval and an ind.
*/
* the rvalue by a
* stklval and an ind.
*/
- if (r
[3] !=
NIL)
+ if (r
->var_node.qual != TR_
NIL)
goto ind;
q = p->type;
goto ind;
q = p->type;
- if (q == NIL)
- return (NIL);
+ if (q == N
LN
IL)
+ return (N
LN
IL);
if (classify(q) == TSTR)
return(stklval(r, NOFLAGS));
# ifdef OBJ
return (stackRV(p));
# endif OBJ
# ifdef PC
if (classify(q) == TSTR)
return(stklval(r, NOFLAGS));
# ifdef OBJ
return (stackRV(p));
# endif OBJ
# ifdef PC
- q = rvalue( r , contype , required );
+ q = rvalue( r , contype ,
(int)
required );
if (isa(q, "sbci")) {
if (isa(q, "sbci")) {
- sconv(p2type(q),P
2
INT);
+ sconv(p2type(q),P
CCT_
INT);
}
return q;
# endif PC
}
return q;
# endif PC
@@
-99,54
+110,54
@@
stkrval(r, contype , required )
*/
ind:
q = stklval(r, NOFLAGS);
*/
ind:
q = stklval(r, NOFLAGS);
- if (q == NIL)
- return (NIL);
+ if (q == N
LN
IL)
+ return (N
LN
IL);
if (classify(q) == TSTR)
return(q);
# ifdef OBJ
w = width(q);
switch (w) {
case 8:
if (classify(q) == TSTR)
return(q);
# ifdef OBJ
w = width(q);
switch (w) {
case 8:
- put(1, O_IND8);
+
(void)
put(1, O_IND8);
return(q);
case 4:
return(q);
case 4:
- put(1, O_IND4);
+
(void)
put(1, O_IND4);
return(q);
case 2:
return(q);
case 2:
- put(1, O_IND24);
+
(void)
put(1, O_IND24);
return(q);
case 1:
return(q);
case 1:
- put(1, O_IND14);
+
(void)
put(1, O_IND14);
return(q);
default:
return(q);
default:
- put(2, O_IND, w);
+
(void)
put(2, O_IND, w);
return(q);
}
# endif OBJ
# ifdef PC
if ( required == RREQ ) {
return(q);
}
# endif OBJ
# ifdef PC
if ( required == RREQ ) {
- putop( P
2UNARY P2
MUL , p2type( q ) );
+ putop( P
CCOM_UNARY PCC_
MUL , p2type( q ) );
if (isa(q,"sbci")) {
if (isa(q,"sbci")) {
- sconv(p2type(q),P
2
INT);
+ sconv(p2type(q),P
CCT_
INT);
}
}
return q;
# endif PC
case CONST:
}
}
return q;
# endif PC
case CONST:
- if (r
[3] !=
NIL) {
- error("%s is a constant and cannot be qualified", r
[2]
);
- return (NIL);
+ if (r
->var_node.qual != TR_
NIL) {
+ error("%s is a constant and cannot be qualified", r
->var_node.cptr
);
+ return (N
LN
IL);
}
q = p->type;
}
q = p->type;
- if (q == NIL)
- return (NIL);
+ if (q == N
LN
IL)
+ return (N
LN
IL);
if (q == nl+TSTR) {
/*
* Find the size of the string
* constant if needed.
*/
if (q == nl+TSTR) {
/*
* Find the size of the string
* constant if needed.
*/
- cp = p->ptr[0];
+ cp =
(char *)
p->ptr[0];
cstrng:
cp1 = cp;
for (c = 0; *cp++; c++)
cstrng:
cp1 = cp;
for (c = 0; *cp++; c++)
@@
-155,12
+166,12
@@
cstrng:
if (contype != NIL && !opt('s')) {
if (width(contype) < c && classify(contype) == TSTR) {
error("Constant string too long");
if (contype != NIL && !opt('s')) {
if (width(contype) < c && classify(contype) == TSTR) {
error("Constant string too long");
- return (NIL);
+ return (N
LN
IL);
}
w = width(contype);
}
# ifdef OBJ
}
w = width(contype);
}
# ifdef OBJ
- put(2, O_LVCON, lenstr(cp1, w - c));
+
(void)
put(2, O_LVCON, lenstr(cp1, w - c));
putstr(cp1, w - c);
# endif OBJ
# ifdef PC
putstr(cp1, w - c);
# endif OBJ
# ifdef PC
@@
-172,16
+183,17
@@
cstrng:
* width.
* cleaned out by stat.
*/
* width.
* cleaned out by stat.
*/
- q = defnl(
0, STR, 0
, w);
+ q = defnl(
(char *) 0, STR, NLNIL
, w);
q->type = q;
return (q);
}
if (q == nl+T1CHAR) {
# ifdef OBJ
q->type = q;
return (q);
}
if (q == nl+T1CHAR) {
# ifdef OBJ
- put(2, O_CONC4, (int)p->value[0]);
+
(void)
put(2, O_CONC4, (int)p->value[0]);
# endif OBJ
# ifdef PC
# endif OBJ
# ifdef PC
- putleaf(P2ICON, p -> value[0], 0, P2INT, 0);
+ putleaf(PCC_ICON, p -> value[0], 0, PCCT_INT,
+ (char *) 0);
# endif PC
return(q);
}
# endif PC
return(q);
}
@@
-192,35
+204,35
@@
cstrng:
switch (width(q)) {
case 8:
#ifndef DEBUG
switch (width(q)) {
case 8:
#ifndef DEBUG
- put(2, O_CON8, p->real);
+
(void)
put(2, O_CON8, p->real);
return(q);
#else
if (hp21mx) {
return(q);
#else
if (hp21mx) {
- f = p->real;
- conv(
&f
);
- l = f.plong;
- put(2, O_CON4, l);
+ f
.pdouble
= p->real;
+ conv(
(int *) (&f.pdouble)
);
+ l = f.plong
[1]
;
+
(void)
put(2, O_CON4, l);
} else
} else
- put(2, O_CON8, p->real);
+
(void)
put(2, O_CON8, p->real);
return(q);
#endif
case 4:
return(q);
#endif
case 4:
- put(2, O_CON4, p->range[0]);
+
(void)
put(2, O_CON4, p->range[0]);
return(q);
case 2:
return(q);
case 2:
- put(2, O_CON24, (short)p->range[0]);
+
(void)
put(2, O_CON24, (short)p->range[0]);
return(q);
case 1:
return(q);
case 1:
- put(2, O_CON14, p->value[0]);
+
(void)
put(2, O_CON14, p->value[0]);
return(q);
default:
panic("stkrval");
}
# endif OBJ
# ifdef PC
return(q);
default:
panic("stkrval");
}
# endif OBJ
# ifdef PC
- q = rvalue( r , contype , required );
+ q = rvalue( r , contype ,
(int)
required );
if (isa(q,"sbci")) {
if (isa(q,"sbci")) {
- sconv(p2type(q),P
2
INT);
+ sconv(p2type(q),P
CCT_
INT);
}
return q;
# endif PC
}
return q;
# endif PC
@@
-230,48
+242,48
@@
cstrng:
/*
* Function call
*/
/*
* Function call
*/
- pt =
(int **)r[3]
;
- if (pt != NIL) {
- switch (pt
[1][0]
) {
+ pt =
r->var_node.qual
;
+ if (pt !=
TR_
NIL) {
+ switch (pt
->list_node.list->tag
) {
case T_PTR:
case T_ARGL:
case T_ARY:
case T_FIELD:
error("Can't qualify a function result value");
case T_PTR:
case T_ARGL:
case T_ARY:
case T_FIELD:
error("Can't qualify a function result value");
- return (NIL);
+ return (N
LN
IL);
}
}
# ifdef OBJ
q = p->type;
if (classify(q) == TSTR) {
c = width(q);
}
}
# ifdef OBJ
q = p->type;
if (classify(q) == TSTR) {
c = width(q);
- put(2, O_LVCON, even(c+1));
+
(void)
put(2, O_LVCON, even(c+1));
putstr("", c);
putstr("", c);
- put(1, PTR_DUP);
+
(void)
put(1, PTR_DUP);
p = funccod(r);
p = funccod(r);
- put(2, O_AS, c);
+
(void)
put(2, O_AS, c);
return(p);
}
p = funccod(r);
if (width(p) <= 2)
return(p);
}
p = funccod(r);
if (width(p) <= 2)
- put(1, O_STOI);
+
(void)
put(1, O_STOI);
# endif OBJ
# ifdef PC
p = pcfunccod( r );
if (isa(p,"sbci")) {
# endif OBJ
# ifdef PC
p = pcfunccod( r );
if (isa(p,"sbci")) {
- sconv(p2type(p),P
2
INT);
+ sconv(p2type(p),P
CCT_
INT);
}
# endif PC
return (p);
case TYPE:
error("Type names (e.g. %s) allowed only in declarations", p->symbol);
}
# endif PC
return (p);
case TYPE:
error("Type names (e.g. %s) allowed only in declarations", p->symbol);
- return (NIL);
+ return (N
LN
IL);
case PROC:
case FPROC:
error("Procedure %s found where expression required", p->symbol);
case PROC:
case FPROC:
error("Procedure %s found where expression required", p->symbol);
- return (NIL);
+ return (N
LN
IL);
default:
panic("stkrvid");
}
default:
panic("stkrvid");
}
@@
-293,24
+305,24
@@
cstrng:
case T_GT:
case T_LT:
case T_IN:
case T_GT:
case T_LT:
case T_IN:
- p = rvalue(r, contype , required );
+ p = rvalue(r, contype ,
(int)
required );
# ifdef OBJ
if (width(p) <= 2)
# ifdef OBJ
if (width(p) <= 2)
- put(1, O_STOI);
+
(void)
put(1, O_STOI);
# endif OBJ
# ifdef PC
if (isa(p,"sbci")) {
# endif OBJ
# ifdef PC
if (isa(p,"sbci")) {
- sconv(p2type(p),P
2
INT);
+ sconv(p2type(p),P
CCT_
INT);
}
# endif PC
return (p);
case T_CSET:
}
# endif PC
return (p);
case T_CSET:
- p = rvalue(r, contype , required );
+ p = rvalue(r, contype ,
(int)
required );
return (p);
default:
return (p);
default:
- if (r
[2] ==
NIL)
- return (NIL);
- switch (r
[0]
) {
+ if (r
->const_node.cptr == (char *)
NIL)
+ return (N
LN
IL);
+ switch (r
->tag
) {
default:
panic("stkrval3");
default:
panic("stkrval3");
@@
-318,34
+330,35
@@
cstrng:
* An octal number
*/
case T_BINT:
* An octal number
*/
case T_BINT:
- f
= a8tol(r[2]
);
+ f
.pdouble = a8tol(r->const_node.cptr
);
goto conint;
/*
* A decimal number
*/
case T_INT:
goto conint;
/*
* A decimal number
*/
case T_INT:
- f
= atof(r[2]
);
+ f
.pdouble = atof(r->const_node.cptr
);
conint:
conint:
- if (f
> MAXINT || f
< MININT) {
+ if (f
.pdouble > MAXINT || f.pdouble
< MININT) {
error("Constant too large for this implementation");
error("Constant too large for this implementation");
- return (NIL);
+ return (N
LN
IL);
}
}
- l = f;
+ l = f
.pdouble
;
if (bytes(l, l) <= 2) {
# ifdef OBJ
if (bytes(l, l) <= 2) {
# ifdef OBJ
- put(2, O_CON24, (short)l);
+
(void)
put(2, O_CON24, (short)l);
# endif OBJ
# ifdef PC
# endif OBJ
# ifdef PC
- putleaf( P2ICON , (short) l , 0 , P2INT , 0 );
+ putleaf( PCC_ICON , (short) l , 0 , PCCT_INT ,
+ (char *) 0 );
# endif PC
return(nl+T4INT);
}
# ifdef OBJ
# endif PC
return(nl+T4INT);
}
# ifdef OBJ
- put(2, O_CON4, l);
+
(void)
put(2, O_CON4, l);
# endif OBJ
# ifdef PC
# endif OBJ
# ifdef PC
- putleaf( P
2ICON , l , 0 , P2INT ,
0 );
+ putleaf( P
CC_ICON , (int) l , 0 , PCCT_INT , (char *)
0 );
# endif PC
return (nl+T4INT);
# endif PC
return (nl+T4INT);
@@
-354,10
+367,10
@@
conint:
*/
case T_FINT:
# ifdef OBJ
*/
case T_FINT:
# ifdef OBJ
-
put(2, O_CON8, atof(r[2]
));
+
(void) put(2, O_CON8, atof(r->const_node.cptr
));
# endif OBJ
# ifdef PC
# endif OBJ
# ifdef PC
- putCON8( atof( r
[2]
) );
+ putCON8( atof( r
->const_node.cptr
) );
# endif PC
return (nl+TDOUBLE);
# endif PC
return (nl+TDOUBLE);
@@
-367,13
+380,14
@@
conint:
* no constant string of length one.
*/
case T_STRNG:
* no constant string of length one.
*/
case T_STRNG:
- cp = r
[2]
;
+ cp = r
->const_node.cptr
;
if (cp[1] == 0) {
# ifdef OBJ
if (cp[1] == 0) {
# ifdef OBJ
- put(2, O_CONC4, cp[0]);
+
(void)
put(2, O_CONC4, cp[0]);
# endif OBJ
# ifdef PC
# endif OBJ
# ifdef PC
- putleaf( P2ICON , cp[0] , 0 , P2INT , 0 );
+ putleaf( PCC_ICON , cp[0] , 0 , PCCT_INT ,
+ (char *) 0 );
# endif PC
return(nl+T1CHAR);
}
# endif PC
return(nl+T1CHAR);
}
@@
-387,32
+401,33
@@
conint:
/*
* push a value onto the interpreter stack, longword aligned.
*/
/*
* push a value onto the interpreter stack, longword aligned.
*/
-stackRV(p)
+struct nl
+*stackRV(p)
struct nl *p;
{
struct nl *q;
int w, bn;
q = p->type;
struct nl *p;
{
struct nl *q;
int w, bn;
q = p->type;
- if (q == NIL)
- return (NIL);
+ if (q == N
LN
IL)
+ return (N
LN
IL);
bn = BLOCKNO(p->nl_block);
w = width(q);
switch (w) {
case 8:
bn = BLOCKNO(p->nl_block);
w = width(q);
switch (w) {
case 8:
- put(2, O_RV8 | bn << 8+INDX, (int)p->value[0]);
+
(void)
put(2, O_RV8 | bn << 8+INDX, (int)p->value[0]);
break;
case 4:
break;
case 4:
- put(2, O_RV4 | bn << 8+INDX, (int)p->value[0]);
+
(void)
put(2, O_RV4 | bn << 8+INDX, (int)p->value[0]);
break;
case 2:
break;
case 2:
- put(2, O_RV24 | bn << 8+INDX, (int)p->value[0]);
+
(void)
put(2, O_RV24 | bn << 8+INDX, (int)p->value[0]);
break;
case 1:
break;
case 1:
- put(2, O_RV14 | bn << 8+INDX, (int)p->value[0]);
+
(void)
put(2, O_RV14 | bn << 8+INDX, (int)p->value[0]);
break;
default:
break;
default:
- put(3, O_RV | bn << 8+INDX, (int)p->value[0], w);
+
(void)
put(3, O_RV | bn << 8+INDX, (int)p->value[0], w);
break;
}
return (q);
break;
}
return (q);
projects / unix-history / blobdiff