-SCCSID = "@(#)Makefile 1.8 %G%"
+SCCSID = "@(#)Makefile 1.9 %G%"
MKSTR = /usr/ucb/mkstr
EYACC = /usr/ucb/eyacc
RM = -rm -f
-GET = sccs get
+GET = sccs -d${SRCDIR} get
CFLAGS = -O -w
LDFLAGS = -z
-INSTALLDIR = /usr/lib
+SRCDIR = /usr/src/cmd/pc0
+INSTALLDIR = /usr/ucb
LIBDIR = /usr/lib
TMPDIR = tmp
-ERRORSTRINGS = pc2.0strings
+ERRORSTRINGS = pi2.0strings
SRCS = ato.c \
call.c case.c clas.c const.c conv.c cset.c \
- error.c fdec.c func.c gen.c hash.c \
+ error.c fdec.c flvalue.c func.c gen.c hash.c \
lab.c lookup.c lval.c stklval.c \
main.c nl.c proc.c put.c \
rec.c rval.c stkrval.c\
TRdata.c \
treen.c putn.c yycopy.c \
yycosts.c yyerror.c yyget.c yyid.c yylex.c yymain.c yyoptions.c \
- yypanic.c yyparse.c yyprint.c yyput.c yyrecover.c yyseman.c yytree.c \
- p2put.c pcforop.c stab.c pcproc.c pcfunc.c pccaseop.c pclval.c
+ yypanic.c yyparse.c yyprint.c yyput.c yyrecover.c yyseman.c yytree.c
-HDRS = 0.h OPnames.h align.h iorec.h objfmt.h pstab.h pc.h pcops.h \
- send.h tree.h whoami.h yy.h
+HDRS = 0.h OPnames.h align.h iorec.h objfmt.h send.h tree.h yy.h \
+ pc.h pcops.h
OTHERS = pas.y opc.c version.c gram pic.c
OBJS = ato.o \
call.o case.o clas.o const.o conv.o cset.o \
- error.o fdec.o func.o gen.o hash.o \
+ error.o fdec.o flvalue.o func.o gen.o hash.o \
lab.o lookup.o lval.o stklval.o \
main.o nl.o proc.o put.o \
rec.o rval.o stkrval.o\
treen.o putn.o yycopy.o \
y.tab.o \
yycosts.o yyerror.o yyget.o yyid.o yylex.o yymain.o yyoptions.o \
- yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o \
- p2put.o pcforop.o stab.o pcproc.o pcfunc.o pccaseop.o pclval.o
+ yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o
a.out: ${OBJS} version
./version > Version.c
${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c
-sources: ${SRCS} ${HDRS} ${OTHERS}
+sources: whoami.h ${SRCS} ${HDRS} ${OTHERS}
${SRCS} ${HDRS} ${OTHERS}:
${GET} ${REL} $@
cd ${TMPDIR} ; ${CC} ${CFLAGS} -I.. -c $*.c ; mv $*.o ../$*.o
${RM} ${TMPDIR}/$*.c
+whoami.h:
+ ${GET} ${REL} piwhoami.h
+ mv piwhoami.h whoami.h
+
y.tab.h: pas.y gram
${EYACC} pas.y > /dev/null
ex - y.tab.c <gram
clean:
${RM} *.o ${TMPDIR}/*.c
- ${RM} y.tab.h y.tab.c y.tab.out
+ ${RM} whoami.h y.tab.h y.tab.c y.tab.out
${RM} ${ERRORSTRINGS}
${RM} version Version.c
${RM} a.out core *.list *.bak
@rm pic
@pr 0.h whoami.h main.c pas.y
@pr OPnames.h opcode.h tree.h
- @pr pc.h
@pr [a-ln-x]*.c
@pr yy.h yy*.c
install: a.out
sccs check
cp ${ERRORSTRINGS} ${LIBDIR}/${ERRORSTRINGS}
- cp ${INSTALLDIR}/pc0 ${INSTALLDIR}/pc0.bak
- cp a.out ${INSTALLDIR}/pc0
+ cp ${INSTALLDIR}/pi ${INSTALLDIR}/pi.bak
+ cp a.out ${INSTALLDIR}/pi
depend: sources
/bin/grep '^#[ ]*include' *.h \
fdec.o: align.h
fdec.o: pc.h
fdec.o: pcops.h
+flvalue.o: whoami.h
+flvalue.o: 0.h
+flvalue.o: tree.h
+flvalue.o: opcode.h
+flvalue.o: objfmt.h
+flvalue.o: pc.h
+flvalue.o: pcops.h
func.o: whoami.h
func.o: 0.h
func.o: tree.h
nl.o: opcode.h
nl.o: objfmt.h
opc.o: OPnames.h
-p2put.o: whoami.h
-p2put.o: 0.h
-p2put.o: pcops.h
-p2put.o: pc.h
-pccaseop.o: whoami.h
-pccaseop.o: 0.h
-pccaseop.o: tree.h
-pccaseop.o: objfmt.h
-pccaseop.o: pcops.h
-pccaseop.o: pc.h
-pcforop.o: whoami.h
-pcforop.o: 0.h
-pcforop.o: opcode.h
-pcforop.o: tree.h
-pcforop.o: pc.h
-pcforop.o: pcops.h
-pcfunc.o: whoami.h
-pcfunc.o: 0.h
-pcfunc.o: tree.h
-pcfunc.o: opcode.h
-pcfunc.o: pc.h
-pcfunc.o: pcops.h
-pclval.o: whoami.h
-pclval.o: 0.h
-pclval.o: tree.h
-pclval.o: opcode.h
-pclval.o: objfmt.h
-pclval.o: pc.h
-pclval.o: pcops.h
-pcproc.o: whoami.h
-pcproc.o: 0.h
-pcproc.o: tree.h
-pcproc.o: opcode.h
-pcproc.o: pc.h
-pcproc.o: pcops.h
pic.o: OPnames.h
proc.o: whoami.h
proc.o: 0.h
rval.o: objfmt.h
rval.o: pc.h
rval.o: pcops.h
-stab.o: whoami.h
-stab.o: 0.h
-stab.o: pstab.h
-stab.o: pc.h
stat.o: whoami.h
stat.o: 0.h
stat.o: tree.h
/* Copyright (c) 1979 Regents of the University of California */
-/* static char sccsid[] = "@(#)0.h 1.2 %G%"; */
+/* static char sccsid[] = "@(#)0.h 1.3 %G%"; */
#define DEBUG
#define CHAR
#define PROG 20
#define IMPROPER 21
#define VARNT 22
+#define FPROC 23
+#define FFUNC 24
/*
* Clnames points to an array of names for the
-/* static char sccsid[] = "@(#)OPnames.h 1.1 %G%"; */
+/* static char sccsid[] = "@(#)OPnames.h 1.2 %G%"; */
char *otext[] = {
0,
- " HALT",
- " TRA4",
" NODUMP",
" BEG",
" END",
" CALL",
- "*ABORT",
- " PUSH",
- " POP",
+ " FCALL",
+ " FRTN",
+ " FSAV",
" SDUP2",
" SDUP4",
- " IF",
" TRA",
- " LINO",
+ " TRA4",
" GOTO",
+ " LINO",
+ " PUSH",
+ 0,
+ " IF",
" REL2",
" REL4",
" REL24",
" REL8",
" RELG",
" RELT",
- 0,
" REL28",
" REL48",
" REL82",
" STLIM",
" LLIMIT",
" BUFF",
- 0,
+ " HALT",
0,
0,
0,
"*CONG",
"*CONC",
"*CONC4",
+ "*ABORT",
" PXPBUF",
" COUNT",
- " TRACNT",
0,
" CASE1OP",
" CASE2OP",
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)call.c 1.2 %G%";
+static char sccsid[] = "@(#)call.c 1.3 %G%";
#include "whoami.h"
#include "0.h"
# include "pcops.h"
#endif PC
+bool slenflag = 0;
+bool floatflag = 0;
+
/*
* Call generates code for calls to
* user defined procedures and functions
register struct nl *p1, *q;
int *r;
+# ifdef OBJ
+ int cnt;
+# endif OBJ
# ifdef PC
long temp;
int firsttime;
# endif PC
# ifdef OBJ
+ if (p->class == FFUNC || p->class == FPROC)
+ put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]);
if (porf == FUNC)
/*
* Push some space
putRV( 0 , cbn , temp , P2STRTY );
}
}
- {
- char extname[ BUFSIZ ];
- char *starthere;
- int funcbn;
- int i;
+ switch ( p -> class ) {
+ case FUNC:
+ case PROC:
+ {
+ char extname[ BUFSIZ ];
+ char *starthere;
+ int funcbn;
+ int i;
- starthere = &extname[0];
- funcbn = p -> nl_block & 037;
- for ( i = 1 ; i < funcbn ; i++ ) {
- sprintf( starthere , EXTFORMAT , enclosing[ i ] );
- starthere += strlen( enclosing[ i ] ) + 1;
- }
- sprintf( starthere , EXTFORMAT , p -> symbol );
- starthere += strlen( p -> symbol ) + 1;
- if ( starthere >= &extname[ BUFSIZ ] ) {
- panic( "call namelength" );
- }
- putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
+ starthere = &extname[0];
+ funcbn = p -> nl_block & 037;
+ for ( i = 1 ; i < funcbn ; i++ ) {
+ sprintf( starthere , EXTFORMAT , enclosing[ i ] );
+ starthere += strlen( enclosing[ i ] ) + 1;
+ }
+ sprintf( starthere , EXTFORMAT , p -> symbol );
+ starthere += strlen( p -> symbol ) + 1;
+ if ( starthere >= &extname[ BUFSIZ ] ) {
+ panic( "call namelength" );
+ }
+ putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
+ }
+ break;
+ case FFUNC:
+ case FPROC:
+ /*
+ * start one of these:
+ * FRTN( frtn , ( *FCALL( frtn ) )(...args...) )
+ */
+ putleaf( P2ICON , 0 , 0 , p2type( p ) , "_FRTN" );
+ putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY );
+ putleaf( P2ICON , 0 , 0
+ , ADDTYPE( P2PTR , ADDTYPE( P2FTN , p2type( p ) ) )
+ , "_FCALL" );
+ putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY );
+ putop( P2CALL , p2type( p ) );
+ break;
+ default:
+ panic("call class");
}
firsttime = TRUE;
# endif PC
* Loop and process each of
* arguments to the proc/func.
*/
- for (p1 = p->chain; p1 != NIL; p1 = p1->chain) {
- if (argv == NIL) {
- error("Not enough arguments to %s", p->symbol);
- return (NIL);
- }
- switch (p1->class) {
- case REF:
- /*
- * Var parameter
- */
- r = argv[1];
- if (r != NIL && r[0] != T_VAR) {
- error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
- break;
- }
- q = lvalue( (int *) argv[1], MOD , LREQ );
- if (q == NIL)
- break;
- if (q != p1->type) {
- error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
- break;
- }
- break;
- case VAR:
- /*
- * Value parameter
- */
+ if ( p -> class == FUNC || p -> class == PROC ) {
+ for (p1 = p->chain; p1 != NIL; p1 = p1->chain) {
+ if (argv == NIL) {
+ error("Not enough arguments to %s", p->symbol);
+ return (NIL);
+ }
+ switch (p1->class) {
+ case REF:
+ /*
+ * Var parameter
+ */
+ r = argv[1];
+ if (r != NIL && r[0] != T_VAR) {
+ error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
+ break;
+ }
+ q = lvalue( (int *) argv[1], MOD , LREQ );
+ if (q == NIL)
+ break;
+ if (q != p1->type) {
+ error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
+ break;
+ }
+ break;
+ case VAR:
+ /*
+ * Value parameter
+ */
# ifdef OBJ
- q = rvalue(argv[1], p1->type , RREQ );
+ q = rvalue(argv[1], p1->type , RREQ );
# endif OBJ
# ifdef PC
- /*
- * structure arguments require lvalues,
- * scalars use rvalue.
- */
- switch( classify( p1 -> type ) ) {
- case TFILE:
- case TARY:
- case TREC:
- case TSET:
- case TSTR:
- q = rvalue( argv[1] , p1 -> type , LREQ );
- break;
- case TINT:
- case TSCAL:
- case TBOOL:
- case TCHAR:
- precheck( p1 -> type , "_RANG4" , "_RSNG4" );
- q = rvalue( argv[1] , p1 -> type , RREQ );
- postcheck( p1 -> type );
+ /*
+ * structure arguments require lvalues,
+ * scalars use rvalue.
+ */
+ switch( classify( p1 -> type ) ) {
+ case TFILE:
+ case TARY:
+ case TREC:
+ case TSET:
+ case TSTR:
+ q = rvalue( argv[1] , p1 -> type , LREQ );
+ break;
+ case TINT:
+ case TSCAL:
+ case TBOOL:
+ case TCHAR:
+ precheck( p1 -> type , "_RANG4" , "_RSNG4" );
+ q = rvalue( argv[1] , p1 -> type , RREQ );
+ postcheck( p1 -> type );
+ break;
+ default:
+ q = rvalue( argv[1] , p1 -> type , RREQ );
+ if ( isa( p1 -> type , "d" )
+ && isa( q , "i" ) ) {
+ putop( P2SCONV , P2DOUBLE );
+ }
+ break;
+ }
+# endif PC
+ if (q == NIL)
break;
- default:
- q = rvalue( argv[1] , p1 -> type , RREQ );
- if ( isa( p1 -> type , "d" )
- && isa( q , "i" ) ) {
- putop( P2SCONV , P2DOUBLE );
- }
+ if (incompat(q, p1->type, argv[1])) {
+ cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
break;
}
-# endif PC
- if (q == NIL)
- break;
- if (incompat(q, p1->type, argv[1])) {
- cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
- break;
- }
# ifdef OBJ
- if (isa(p1->type, "bcsi"))
- rangechk(p1->type, q);
- if (q->class != STR)
- convert(q, p1->type);
+ if (isa(p1->type, "bcsi"))
+ rangechk(p1->type, q);
+ if (q->class != STR)
+ convert(q, p1->type);
# endif OBJ
# ifdef PC
- switch( classify( p1 -> type ) ) {
- case TFILE:
- case TARY:
- case TREC:
- case TSET:
- case TSTR:
- putstrop( P2STARG
- , p2type( p1 -> type )
- , lwidth( p1 -> type )
- , align( p1 -> type ) );
- }
+ switch( classify( p1 -> type ) ) {
+ case TFILE:
+ case TARY:
+ case TREC:
+ case TSET:
+ case TSTR:
+ putstrop( P2STARG
+ , p2type( p1 -> type )
+ , lwidth( p1 -> type )
+ , align( p1 -> type ) );
+ }
# endif PC
- break;
- default:
- panic("call");
- }
-# ifdef PC
- /*
- * if this is the nth (>1) argument,
- * hang it on the left linear list of arguments
- */
- if ( firsttime ) {
- firsttime = FALSE;
- } else {
- putop( P2LISTOP , P2INT );
+ break;
+ case FFUNC:
+ /*
+ * function parameter
+ */
+ q = flvalue( (int *) argv[1] , FFUNC );
+ if (q == NIL)
+ break;
+ if (q != p1->type) {
+ error("Function type not identical to type of function parameter %s of %s", p1->symbol, p->symbol);
+ break;
+ }
+ break;
+ case FPROC:
+ /*
+ * procedure parameter
+ */
+ q = flvalue( (int *) argv[1] , FPROC );
+ if (q != NIL) {
+ error("Procedure parameter %s of %s cannot have a type", p1->symbol, p->symbol);
+ }
+ break;
+ default:
+ panic("call");
}
+# ifdef PC
+ /*
+ * if this is the nth (>1) argument,
+ * hang it on the left linear list of arguments
+ */
+ if ( firsttime ) {
+ firsttime = FALSE;
+ } else {
+ putop( P2LISTOP , P2INT );
+ }
# endif PC
- argv = argv[2];
- }
- if (argv != NIL) {
- error("Too many arguments to %s", p->symbol);
- rvlist(argv);
- return (NIL);
+ argv = argv[2];
+ }
+ if (argv != NIL) {
+ error("Too many arguments to %s", p->symbol);
+ rvlist(argv);
+ return (NIL);
+ }
+ } else if ( p -> class == FFUNC || p -> class == FPROC ) {
+ /*
+ * formal routines can only have by-value parameters.
+ * this will lose for integer actuals passed to real
+ * formals, and strings which people want blank padded.
+ */
+# ifdef OBJ
+ cnt = 0;
+# endif OBJ
+ for ( ; argv != NIL ; argv = argv[2] ) {
+# ifdef OBJ
+ q = rvalue(argv[1], NIL, RREQ );
+ cnt += even(lwidth(q));
+# endif OBJ
+# ifdef PC
+ /*
+ * structure arguments require lvalues,
+ * scalars use rvalue.
+ */
+ codeoff();
+ p1 = rvalue( argv[1] , NIL , RREQ );
+ codeon();
+ switch( classify( p1 ) ) {
+ case TSTR:
+ if ( p1 -> class == STR && slenflag == 0 ) {
+ if ( opt( 's' ) ) {
+ standard();
+ } else {
+ warning();
+ }
+ error("Implementation can't construct equal length strings");
+ slenflag++;
+ }
+ /* and fall through */
+ case TFILE:
+ case TARY:
+ case TREC:
+ case TSET:
+ q = rvalue( argv[1] , p1 , LREQ );
+ break;
+ case TINT:
+ if ( floatflag == 0 ) {
+ if ( opt( 's' ) ) {
+ standard();
+ } else {
+ warning();
+ }
+ error("Implementation can't coerice integer to real");
+ floatflag++;
+ }
+ /* and fall through */
+ case TSCAL:
+ case TBOOL:
+ case TCHAR:
+ default:
+ q = rvalue( argv[1] , p1 , RREQ );
+ break;
+ }
+ switch( classify( p1 ) ) {
+ case TFILE:
+ case TARY:
+ case TREC:
+ case TSET:
+ case TSTR:
+ putstrop( P2STARG , p2type( p1 ) ,
+ lwidth( p1 ) , align( p1 ) );
+ }
+ /*
+ * if this is the nth (>1) argument,
+ * hang it on the left linear list of arguments
+ */
+ if ( firsttime ) {
+ firsttime = FALSE;
+ } else {
+ putop( P2LISTOP , P2INT );
+ }
+# endif PC
+ }
+ } else {
+ panic("call class");
}
# ifdef OBJ
- put2(O_CALL | psbn << 8+INDX, p->entloc);
- put2(O_POP, p->value[NL_OFFS]-DPOFF2);
+ if ( p -> class == FFUNC || p -> class == FPROC ) {
+ put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]);
+ put(2, O_FCALL, cnt);
+ put(2, O_FRTN, even(lwidth(p->type)));
+ } else {
+ put2(O_CALL | psbn << 8+INDX, p->entloc);
+ }
# endif OBJ
# ifdef PC
if ( porf == FUNC ) {
case TSCAL:
case TDOUBLE:
case TPTR:
- if ( p -> chain == NIL ) {
+ if ( firsttime ) {
putop( P2UNARY P2CALL , rettype );
} else {
putop( P2CALL , rettype );
}
+ if (p -> class == FFUNC || p -> class == FPROC ) {
+ putop( P2LISTOP , P2INT );
+ putop( P2CALL , rettype );
+ }
break;
default:
- if ( p -> chain == NIL ) {
+ if ( firsttime ) {
putstrop( P2UNARY P2STCALL
, ADDTYPE( rettype , P2PTR )
, lwidth( p -> type )
, lwidth( p -> type )
, align( p -> type ) );
}
+ if (p -> class == FFUNC || p -> class == FPROC ) {
+ putop( P2LISTOP , P2INT );
+ putop( P2CALL , ADDTYPE( rettype , P2PTR ) );
+ }
putstrop( P2STASG , rettype , lwidth( p -> type )
, align( p -> type ) );
putLV( 0 , cbn , temp , rettype );
break;
}
} else {
- if ( p -> chain == NIL ) {
+ if ( firsttime ) {
putop( P2UNARY P2CALL , P2INT );
} else {
putop( P2CALL , P2INT );
}
+ if (p -> class == FFUNC || p -> class == FPROC ) {
+ putop( P2LISTOP , P2INT );
+ putop( P2CALL , P2INT );
+ }
putdot( filename , line );
}
# endif PC
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)fdec.c 1.3 %G%";
+static char sccsid[] = "@(#)fdec.c 1.4 %G%";
#include "whoami.h"
#include "0.h"
case TREC:
case TSET:
case TSTR:
- warning();
- if (opt('s'))
+ if (opt('s')) {
standard();
- error("Functions should not return %ss", clnames[o]);
+ error("Functions should not return %ss", clnames[o]);
+ }
}
# ifdef PC
enclosing[ cbn ] = r[2];
# endif PC
break;
case T_PFUNC:
+# ifdef OBJ
+ dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) );
+# endif OBJ
+# ifdef PC
+ dp = defnl( il[1] , FFUNC , p
+ , o = roundup( o , A_STACK ) );
+ o += sizeof(char *);
+# endif PC
+ dp -> nl_flags |= NMOD;
+ break;
case T_PPROC:
- error("Procedure/function parameters not implemented");
- continue;
+# ifdef OBJ
+ dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) );
+# endif OBJ
+# ifdef PC
+ dp = defnl( il[1] , FPROC , p
+ , o = roundup( o , A_STACK ) );
+ o += sizeof(char *);
+# endif PC
+ dp -> nl_flags |= NMOD;
+ break;
}
if (dp != NIL) {
cp->chain = dp;
*/
var = put(2, (lenstr(fp->symbol,0) << 8)
| (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0);
+ /*
+ * output the number of bytes of arguments
+ * this is only checked on formal calls.
+ */
+ put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2);
put(2, O_CASE2, bundle[1]);
putstr(fp->symbol, 0);
#endif OBJ
* and zero them if checking is on
* by calling zframe( bytes of locals , highest local address );
*/
- if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
- putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
- , "_ZFRAME" );
- putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1
- , 0 , P2INT , 0 );
- putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
- putop( P2LISTOP , P2INT );
- putop( P2CALL , P2INT );
- putdot( filename , line );
+ if ( opt( 't' ) ) {
+ if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
+ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
+ , "_ZFRAME" );
+ putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1
+ , 0 , P2INT , 0 );
+ putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
+ putop( P2LISTOP , P2INT );
+ putop( P2CALL , P2INT );
+ putdot( filename , line );
+ }
+ /*
+ * check number of longs of arguments
+ * this can only be wrong for formal calls.
+ */
+ if ( fp -> class != PROG ) {
+ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) ,
+ "_NARGCHK" );
+ putleaf( P2ICON ,
+ (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) ,
+ 0 , P2INT , 0 );
+ putop( P2CALL , P2INT );
+ putdot( filename , line );
+ }
}
#endif PC
if ( monflg ) {
if ( fp -> class == FUNC ) {
struct nl *fvar = fp -> ptr[ NL_FVAR ];
long fvartype = p2type( fvar -> type );
+ long label;
+ char labelname[ BUFSIZ ];
switch ( classify( fvar -> type ) ) {
case TBOOL:
, fvar -> value[ NL_OFFS ] , fvartype );
break;
default:
+ label = getlab();
+ sprintf( labelname , PREFIXFORMAT ,
+ LABELPREFIX , label );
+ putprintf( " .data" , 0 );
+ putprintf( " .lcomm %s,%d" , 0 ,
+ labelname , lwidth( fvar -> type ) );
+ putprintf( " .text" , 0 );
+ putRV( labelname , 0 , 0 , fvartype );
putLV( fvar -> symbol , ( fvar -> nl_block ) & 037
, fvar -> value[ NL_OFFS ] , fvartype );
+ putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
+ align( fvar -> type ) );
+ putLV( labelname , 0 , 0 , fvartype );
break;
}
putop( P2FORCE , fvartype );
/* Copyright (c) 1980 Regents of the University of California */
-static char sccsid[] = "@(#)flvalue.c 1.1 %G%";
+static char sccsid[] = "@(#)flvalue.c 1.2 %G%";
#include "whoami.h"
#include "0.h"
# include "pc.h"
# include "pcops.h"
#endif PC
+#ifdef OBJ
+/*
+ * define the display structure for purposes of allocating
+ * a temporary
+ */
+struct dispsave {
+ char *ptr;
+};
+#endif OBJ
/*
* flvalue generates the code to either pass on a formal routine,
* it tells the difference by looking at the tree it's given.
*/
struct nl *
-flvalue( r )
- int *r;
+flvalue( r , formalp )
+ int *r;
+ struct nl *formalp;
{
struct nl *p;
long tempoff;
+ char *typename;
if ( r == NIL ) {
return NIL;
}
+ typename = formalp -> class == FFUNC ? "function":"procedure";
+ if ( r[0] != T_VAR ) {
+ error("Expression given, %s required for %s parameter %s" ,
+ typename , typename , formalp -> symbol );
+ return NIL;
+ }
p = lookup(r[2]);
if (p == NIL) {
- return NIL;
+ return NIL;
}
- switch ( r[0] ) {
- case T_FFUNC:
- if ( r[3] != NIL ) {
- error("Formal function %s cannot be qualified" ,
- p -> symbol );
- return NIL;
- }
- goto froutine;
- case T_FPROC:
+ switch ( p -> class ) {
+ case FFUNC:
+ case FPROC:
if ( r[3] != NIL ) {
- error("Formal procedure %s cannot be qualified" ,
- p -> symbol );
+ error("Formal %s %s cannot be qualified" ,
+ typename , p -> symbol );
return NIL;
}
- froutine:
# ifdef OBJ
put( 2 , PTR_RV | bn << 8+INDX , p -> value[NL_OFFS] );
# endif OBJ
p2type( p ) );
# endif PC
return p -> type;
- case T_FUNC:
+ case FUNC:
+ case PROC:
if ( r[3] != NIL ) {
- error("Function %s cannot be qualified" , p -> symbol );
+ error("%s %s cannot be qualified" , typename ,
+ p -> symbol );
return NIL;
}
- goto routine;
- case T_PROC:
- if ( r[3] != NIL ) {
- error("Procedure %s cannot be qualified", p -> symbol );
+ if (bn == 0) {
+ error("Built-in %s %s cannot be passed as a parameter" ,
+ typename , p -> symbol );
return NIL;
}
- routine:
/*
* formal routine structure:
*
* struct dispsave disp[2*MAXLVL];
* };
*/
- sizes[ cbn ].om_off -= sizeof (long (*()))
+ sizes[ cbn ].om_off -= sizeof (long (*)())
+ sizeof (long)
+ 2*bn*sizeof (struct dispsave);
tempoff = sizes[ cbn ].om_off;
sizes[ cbn ].om_max = tempoff;
}
# ifdef OBJ
- put( 2 , PTR_LV | cbn << 8 + INDX , tempoff );
+ put( 2 , O_LV | cbn << 8 + INDX , tempoff );
put( 2 , O_FSAV | bn << 8 + INDX , p -> entloc );
# endif OBJ
# ifdef PC
putlbracket( ftnno , -tempoff );
putleaf( P2ICON , 0 , 0 ,
- ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STR ) ) ,
+ ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) ,
"_FSAV" );
{
char extname[ BUFSIZ ];
}
putleaf( P2ICON , bn , 0 , P2INT , 0 );
putop( P2LISTOP , P2INT );
- putLV( 0 , cbn , tempoff , P2STR );
+ putLV( 0 , cbn , tempoff , P2STRTY );
putop( P2LISTOP , P2INT );
putop( P2CALL , P2PTR | P2STRTY );
# endif PC
return p -> type;
default:
- panic("flvalue");
+ error("Variable given, %s required for %s parameter %s" ,
+ typename , typename , formalp -> symbol );
+ return NIL;
}
}
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)func.c 1.1 %G%";
+static char sccsid[] = "@(#)func.c 1.2 %G%";
#include "whoami.h"
#ifdef OBJ
rvlist(r[3]);
return (NIL);
}
- if (p->class != FUNC) {
+ if (p->class != FUNC && p->class != FFUNC) {
error("%s is not a function", p->symbol);
rvlist(r[3]);
return (NIL);
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)nl.c 1.1 %G%";
+static char sccsid[] = "@(#)nl.c 1.2 %G%";
#include "whoami.h"
#include "0.h"
"scalar",
"string",
"program",
- "improper"
-#ifdef DEBUG
- ,"variant"
-#endif
+ "improper",
+ "variant",
+ "formal procedure",
+ "formal function"
};
char *snark = "SNARK";
"STR",
"PROG",
"IMPROPER",
- "VARNT"
+ "VARNT",
+ "FPROC",
+ "FFUNC"
};
char *stars = "\t***";
case VAR:
case REF:
case WITHPTR:
+ case FFUNC:
+ case FPROC:
printf("\t%d,%d", cbn, v);
break;
case SCAL:
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)p2put.c 1.1 %G%";
+static char sccsid[] = "@(#)p2put.c 1.2 %G%";
/*
* functions to help pi put out
* which return integers (whether you look at them or not)
*/
return ADDTYPE( ADDTYPE( P2INT , P2FTN ) , P2PTR );
+ case FFUNC :
+ case FPROC :
+ /*
+ * formal procedures and functions are pointers
+ * to structures which describe their environment.
+ */
+ return ADDTYPE( P2PTR , P2STRTY );
default :
fprintf( stderr , "[p2type] np -> class %d\n" , np -> class );
panic( "p2type" );
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)pcfunc.c 1.1 %G%";
+static char sccsid[] = "@(#)pcfunc.c 1.2 %G%";
#include "whoami.h"
#ifdef PC
rvlist(r[3]);
return (NIL);
}
- if (p->class != FUNC) {
+ if (p->class != FUNC && p->class != FFUNC) {
error("%s is not a function", p->symbol);
rvlist(r[3]);
return (NIL);
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)pcproc.c 1.1 %G%";
+static char sccsid[] = "@(#)pcproc.c 1.2 %G%";
#include "whoami.h"
#ifdef PC
rvlist(r[3]);
return;
}
- if (p->class != PROC) {
+ if (p->class != PROC && p->class != FPROC) {
error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
rvlist(r[3]);
return;
-SCCSID = "@(#)pimakefile 1.8 %G%"
+SCCSID = "@(#)pimakefile 1.9 %G%"
MKSTR = /usr/ucb/mkstr
EYACC = /usr/ucb/eyacc
RM = -rm -f
-GET = sccs get
+GET = sccs -d${SRCDIR} get
CFLAGS = -O -w
LDFLAGS = -z
-INSTALLDIR = /usr/lib
+SRCDIR = /usr/src/cmd/pc0
+INSTALLDIR = /usr/ucb
LIBDIR = /usr/lib
TMPDIR = tmp
-ERRORSTRINGS = pc2.0strings
+ERRORSTRINGS = pi2.0strings
SRCS = ato.c \
call.c case.c clas.c const.c conv.c cset.c \
- error.c fdec.c func.c gen.c hash.c \
+ error.c fdec.c flvalue.c func.c gen.c hash.c \
lab.c lookup.c lval.c stklval.c \
main.c nl.c proc.c put.c \
rec.c rval.c stkrval.c\
TRdata.c \
treen.c putn.c yycopy.c \
yycosts.c yyerror.c yyget.c yyid.c yylex.c yymain.c yyoptions.c \
- yypanic.c yyparse.c yyprint.c yyput.c yyrecover.c yyseman.c yytree.c \
- p2put.c pcforop.c stab.c pcproc.c pcfunc.c pccaseop.c pclval.c
+ yypanic.c yyparse.c yyprint.c yyput.c yyrecover.c yyseman.c yytree.c
-HDRS = 0.h OPnames.h align.h iorec.h objfmt.h pstab.h pc.h pcops.h \
- send.h tree.h whoami.h yy.h
+HDRS = 0.h OPnames.h align.h iorec.h objfmt.h send.h tree.h yy.h \
+ pc.h pcops.h
OTHERS = pas.y opc.c version.c gram pic.c
OBJS = ato.o \
call.o case.o clas.o const.o conv.o cset.o \
- error.o fdec.o func.o gen.o hash.o \
+ error.o fdec.o flvalue.o func.o gen.o hash.o \
lab.o lookup.o lval.o stklval.o \
main.o nl.o proc.o put.o \
rec.o rval.o stkrval.o\
treen.o putn.o yycopy.o \
y.tab.o \
yycosts.o yyerror.o yyget.o yyid.o yylex.o yymain.o yyoptions.o \
- yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o \
- p2put.o pcforop.o stab.o pcproc.o pcfunc.o pccaseop.o pclval.o
+ yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o
a.out: ${OBJS} version
./version > Version.c
${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c
-sources: ${SRCS} ${HDRS} ${OTHERS}
+sources: whoami.h ${SRCS} ${HDRS} ${OTHERS}
${SRCS} ${HDRS} ${OTHERS}:
${GET} ${REL} $@
cd ${TMPDIR} ; ${CC} ${CFLAGS} -I.. -c $*.c ; mv $*.o ../$*.o
${RM} ${TMPDIR}/$*.c
+whoami.h:
+ ${GET} ${REL} piwhoami.h
+ mv piwhoami.h whoami.h
+
y.tab.h: pas.y gram
${EYACC} pas.y > /dev/null
ex - y.tab.c <gram
clean:
${RM} *.o ${TMPDIR}/*.c
- ${RM} y.tab.h y.tab.c y.tab.out
+ ${RM} whoami.h y.tab.h y.tab.c y.tab.out
${RM} ${ERRORSTRINGS}
${RM} version Version.c
${RM} a.out core *.list *.bak
@rm pic
@pr 0.h whoami.h main.c pas.y
@pr OPnames.h opcode.h tree.h
- @pr pc.h
@pr [a-ln-x]*.c
@pr yy.h yy*.c
install: a.out
sccs check
cp ${ERRORSTRINGS} ${LIBDIR}/${ERRORSTRINGS}
- cp ${INSTALLDIR}/pc0 ${INSTALLDIR}/pc0.bak
- cp a.out ${INSTALLDIR}/pc0
+ cp ${INSTALLDIR}/pi ${INSTALLDIR}/pi.bak
+ cp a.out ${INSTALLDIR}/pi
depend: sources
/bin/grep '^#[ ]*include' *.h \
fdec.o: align.h
fdec.o: pc.h
fdec.o: pcops.h
+flvalue.o: whoami.h
+flvalue.o: 0.h
+flvalue.o: tree.h
+flvalue.o: opcode.h
+flvalue.o: objfmt.h
+flvalue.o: pc.h
+flvalue.o: pcops.h
func.o: whoami.h
func.o: 0.h
func.o: tree.h
nl.o: opcode.h
nl.o: objfmt.h
opc.o: OPnames.h
-p2put.o: whoami.h
-p2put.o: 0.h
-p2put.o: pcops.h
-p2put.o: pc.h
-pccaseop.o: whoami.h
-pccaseop.o: 0.h
-pccaseop.o: tree.h
-pccaseop.o: objfmt.h
-pccaseop.o: pcops.h
-pccaseop.o: pc.h
-pcforop.o: whoami.h
-pcforop.o: 0.h
-pcforop.o: opcode.h
-pcforop.o: tree.h
-pcforop.o: pc.h
-pcforop.o: pcops.h
-pcfunc.o: whoami.h
-pcfunc.o: 0.h
-pcfunc.o: tree.h
-pcfunc.o: opcode.h
-pcfunc.o: pc.h
-pcfunc.o: pcops.h
-pclval.o: whoami.h
-pclval.o: 0.h
-pclval.o: tree.h
-pclval.o: opcode.h
-pclval.o: objfmt.h
-pclval.o: pc.h
-pclval.o: pcops.h
-pcproc.o: whoami.h
-pcproc.o: 0.h
-pcproc.o: tree.h
-pcproc.o: opcode.h
-pcproc.o: pc.h
-pcproc.o: pcops.h
pic.o: OPnames.h
proc.o: whoami.h
proc.o: 0.h
rval.o: objfmt.h
rval.o: pc.h
rval.o: pcops.h
-stab.o: whoami.h
-stab.o: 0.h
-stab.o: pstab.h
-stab.o: pc.h
stat.o: whoami.h
stat.o: 0.h
stat.o: tree.h
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)proc.c 1.1 %G%";
+static char sccsid[] = "@(#)proc.c 1.2 %G%";
#include "whoami.h"
#ifdef OBJ
rvlist(r[3]);
return;
}
- if (p->class != PROC) {
+ if (p->class != PROC && p->class != FPROC) {
error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
rvlist(r[3]);
return;
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)put.c 1.2 %G%";
+static char sccsid[] = "@(#)put.c 1.3 %G%";
#include "whoami.h"
#include "opcode.h"
case O_CASE1OP:
case O_CASE2OP:
case O_CASE4OP:
+ case O_FRTN:
case O_WRITES:
case O_WRITEF:
case O_MAX:
#endif
word( ( short ) *( ( long * ) &p[1] ) );
return (oldlc);
- case O_POP:
+ case O_FCALL:
+ if (p[1] == 0)
+ goto longgen;
+ /* and fall through */
case O_PUSH:
if (p[1] == 0)
return (oldlc);
goto longgen;
case O_TRA4:
case O_CALL:
+ case O_FSAV:
case O_GOTO:
- case O_TRACNT:
case O_NAM:
case O_READE:
/* absolute long addressing */
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)rval.c 1.1 %G%";
+static char sccsid[] = "@(#)rval.c 1.2 %G%";
#include "whoami.h"
#include "0.h"
return (q);
case FUNC:
+ case FFUNC:
/*
* Function call with no arguments.
*/
return (NIL);
case PROC:
+ case FPROC:
error("Procedure %s found where expression required", p->symbol);
return (NIL);
default:
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)stkrval.c 1.2 %G%";
+static char sccsid[] = "@(#)stkrval.c 1.3 %G%";
#include "whoami.h"
#include "0.h"
# endif PC
case FUNC:
+ case FFUNC:
/*
* Function call
*/
return (NIL);
case PROC:
+ case FPROC:
error("Procedure %s found where expression required", p->symbol);
return (NIL);
default:
/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)yyid.c 1.1 %G%";
+static char sccsid[] = "@(#)yyid.c 1.2 %G%";
#include "whoami.h"
#include "0.h"
p->chain = udp;
}
-#define varkinds ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR)|(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR))
+#define varkinds ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR) \
+ |(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR) \
+ |(1<<FFUNC)|(1<<PROC)|(1<<FPROC))
/*
* Is the symbol in the p entry of the namelist
* even possibly a kind kind? If not, update
switch (kind) {
case FUNC:
- if (p->class == FVAR)
- return(1);
+ return ( p -> class == FUNC
+ || p -> class == FVAR
+ || p -> class == FFUNC );
+ case PROC:
+ return ( p -> class == PROC || p -> class == FPROC );
case CONST:
case TYPE:
- case PROC:
case FIELD:
return (p->class == kind);
case VAR:
* parameterless functions only.
*/
case FUNC:
+ case FFUNC:
return (class == NIL || (p->type != NIL && p->type->class == class));
+ case PROC:
+ case FPROC:
+ return ( class == NIL );
}
return (0);
}