X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/4357ce5ea033bc0b7a2db05ecd5d2c28759de92e..af359dea2e5ab3e937b62107ecd6a51d78189ed7:/usr/src/usr.bin/pascal/src/call.c?ds=inline

diff --git a/usr/src/usr.bin/pascal/src/call.c b/usr/src/usr.bin/pascal/src/call.c
index bedbd292c2..cde1355d8c 100644
--- a/usr/src/usr.bin/pascal/src/call.c
+++ b/usr/src/usr.bin/pascal/src/call.c
@@ -1,17 +1,52 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*-
+ * Copyright (c) 1980 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *	This product includes software developed by the University of
+ *	California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
 
-static	char sccsid[] = "@(#)call.c 1.24 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)call.c	5.4 (Berkeley) 4/16/91";
+#endif /* not lint */
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "opcode.h"
 #include "objfmt.h"
+#include "align.h"
 #ifdef PC
 #   include "pc.h"
-#   include "pcops.h"
+#   include <pcc.h>
 #endif PC
 #include "tmps.h"
+#include "tree_ty.h"
 
 /*
  * Call generates code for calls to
@@ -49,20 +84,21 @@ static	char sccsid[] = "@(#)call.c 1.24 %G%";
  *		(t=p,temp = ( t -> entryaddr )(...args...,t,s),FRTN(t,s),&temp)
  */
 struct nl *
-call(p, argv, porf, psbn)
+call(p, argv_node, porf, psbn)
 	struct nl *p;
-	int *argv, porf, psbn;
+	struct tnode	*argv_node;	/* list node */
+	int porf, psbn;
 {
-	register struct nl *p1, *q;
-	int *r;
-	struct nl	*p_type_class = classify( p -> type );
+	register struct nl *p1, *q, *p2;
+	register struct nl *ptype, *ctype;
+	struct tnode *rnode;
+	int i, j, d;
 	bool chk = TRUE;
  	struct nl	*savedispnp;	/* temporary to hold saved display */
 #	ifdef PC
-	    long	p_p2type = p2type( p );
+	    int		p_type_class = classify( p -> type );
 	    long	p_type_p2type = p2type( p -> type );
 	    bool	noarguments;
-	    long	calltype;	/* type of the call */
 		/*
 		 *	these get used if temporaries and structures are used
 		 */
@@ -78,20 +114,21 @@ call(p, argv, porf, psbn)
  	    /*
  	     * allocate space to save the display for formal calls
  	     */
-	    savedispnp = tmpalloc( sizeof display , NIL , NOREG );
+	    savedispnp = tmpalloc( (long) sizeof display , NLNIL , NOREG );
  	}
 #	ifdef OBJ
 	    if (p->class == FFUNC || p->class == FPROC) {
- 		put(2, O_LV | cbn << 8 + INDX ,
+ 		(void) put(2, O_LV | cbn << 8 + INDX ,
  			(int) savedispnp -> value[ NL_OFFS ] );
-		put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]);
+		(void) put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]);
 	    }
 	    if (porf == FUNC) {
 		    /*
 		     * Push some space
 		     * for the function return type
 		     */
-		    put(2, O_PUSH, leven(-lwidth(p->type)));
+		    (void) put(2, O_PUSH,
+			-roundup(lwidth(p->type), (long) A_STACK));
 	    }
 #	endif OBJ
 #	ifdef PC
@@ -102,21 +139,20 @@ call(p, argv, porf, psbn)
 		 *	after the FCALL for the call to FRTN
 		 */
 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
-		tempdescrp = tmpalloc(sizeof( struct formalrtn *) , NIL ,
-					REGOK );
-		putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
-			tempdescrp -> extra_flags , P2PTR|P2STRTY );
-		putRV( 0 , psbn , p -> value[ NL_OFFS ] ,
-			p -> extra_flags , P2PTR|P2STRTY );
-		putop( P2ASSIGN , P2PTR | P2STRTY );
+		tempdescrp = tmpalloc((long) (sizeof( struct formalrtn *)),
+					NLNIL, REGOK );
+		putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
+			tempdescrp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
+		putRV((char *) 0 , psbn , p -> value[ NL_OFFS ] ,
+			p -> extra_flags , PCCTM_PTR|PCCT_STRTY );
+		putop( PCC_ASSIGN , PCCTM_PTR | PCCT_STRTY );
 	    }
 		/*
 		 *	if we have to store a temporary,
 		 *	temptype will be its type,
-		 *	otherwise, it's P2UNDEF.
+		 *	otherwise, it's PCCT_UNDEF.
 		 */
-	    temptype = P2UNDEF;
-	    calltype = P2INT;
+	    temptype = PCCT_UNDEF;
 	    if ( porf == FUNC ) {
 		p_type_width = width( p -> type );
 		switch( p_type_class ) {
@@ -125,23 +161,23 @@ call(p, argv, porf, psbn)
 		    case TREC:
 		    case TFILE:
 		    case TARY:
-			calltype = temptype = P2STRTY;
+			temptype = PCCT_STRTY;
 			p_type_align = align( p -> type );
 			break;
 		    default:
 			if ( p -> class == FFUNC ) {
-			    calltype = temptype = p2type( p -> type );
+			    temptype = p2type( p -> type );
 			}
 			break;
 		}
-		if ( temptype != P2UNDEF ) {
+		if ( temptype != PCCT_UNDEF ) {
 		    tempnlp = tmpalloc(p_type_width, p -> type, NOREG);
 			/*
 			 *	temp
 			 *	for (temp = ...
 			 */
-		    putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
-			    tempnlp -> extra_flags , temptype );
+		    putRV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
+			    tempnlp -> extra_flags , (int) temptype );
 		}
 	    }
 	    switch ( p -> class ) {
@@ -151,7 +187,7 @@ call(p, argv, porf, psbn)
 			 *	... p( ...
 			 */
 		    sextname( extname , p -> symbol , BLOCKNO(p -> nl_block) );
-		    putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
+		    putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
 		    break;
 		case FFUNC:
 		case FPROC:
@@ -160,29 +196,30 @@ call(p, argv, porf, psbn)
 			     *	... ( t -> entryaddr )( ...
 			     */
 			    /* 	the descriptor */
-			putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
-				tempdescrp -> extra_flags , P2PTR | P2STRTY );
+			putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
+				tempdescrp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
 			    /*	the entry address within the descriptor */
 			if ( FENTRYOFFSET != 0 ) {
-			    putleaf( P2ICON , FENTRYOFFSET , 0 , P2INT , 0 );
-			    putop( P2PLUS , 
-				ADDTYPE(
-				    ADDTYPE( ADDTYPE( p2type( p ) , P2FTN ) ,
-					    P2PTR ) ,
-					P2PTR ) );
+			    putleaf( PCC_ICON , FENTRYOFFSET , 0 , PCCT_INT , 
+						(char *) 0 );
+			    putop( PCC_PLUS , 
+				PCCM_ADDTYPE(
+				    PCCM_ADDTYPE( PCCM_ADDTYPE( p2type( p ) , PCCTM_FTN ) ,
+					    PCCTM_PTR ) ,
+					PCCTM_PTR ) );
 			}
 			    /*
 			     *	indirect to fetch the formal entry address
 			     *	with the result type of the routine.
 			     */
 			if (p -> class == FFUNC) {
-			    putop( P2UNARY P2MUL ,
-				ADDTYPE(ADDTYPE(p2type(p -> type), P2FTN),
-					P2PTR));
+			    putop( PCCOM_UNARY PCC_MUL ,
+				PCCM_ADDTYPE(PCCM_ADDTYPE(p2type(p -> type), PCCTM_FTN),
+					PCCTM_PTR));
 			} else {
 				/* procedures are int returning functions */
-			    putop( P2UNARY P2MUL ,
-				ADDTYPE(ADDTYPE(P2INT, P2FTN), P2PTR));
+			    putop( PCCOM_UNARY PCC_MUL ,
+				PCCM_ADDTYPE(PCCM_ADDTYPE(PCCT_INT, PCCTM_FTN), PCCTM_PTR));
 			}
 			break;
 		default:
@@ -195,31 +232,126 @@ call(p, argv, porf, psbn)
 	 * arguments to the proc/func.
 	 *	... ( ... args ... ) ...
 	 */
-	for (p1 = plist(p); p1 != NIL; p1 = p1->chain) {
-	    if (argv == NIL) {
+	ptype = NIL;
+	for (p1 = plist(p); p1 != NLNIL; p1 = p1->chain) {
+	    if (argv_node == TR_NIL) {
 		    error("Not enough arguments to %s", p->symbol);
-		    return (NIL);
+		    return (NLNIL);
 	    }
 	    switch (p1->class) {
 		case REF:
 			/*
 			 * Var parameter
 			 */
-			r = argv[1];
-			if (r != NIL && r[0] != T_VAR) {
+			rnode = argv_node->list_node.list;
+			if (rnode != TR_NIL && rnode->tag != T_VAR) {
 				error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
 				chk = FALSE;
 				break;
 			}
-			q = lvalue( (int *) argv[1], MOD | ASGN , LREQ );
+			q = lvalue( argv_node->list_node.list,
+					MOD | ASGN , LREQ );
 			if (q == NIL) {
 				chk = FALSE;
 				break;
 			}
-			if (q != p1->type) {
+			p2 = p1->type;
+			if (p2 == NLNIL || p2->chain == NLNIL || p2->chain->class != CRANGE) {
+			    if (q != p2) {
 				error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
 				chk = FALSE;
-				break;
+			    }
+			    break;
+			} else {
+			    /* conformant array */
+			    if (p1 == ptype) {
+				if (q != ctype) {
+				    error("Conformant array parameters in the same specification must be the same type.");
+				    goto conf_err;
+				}
+			    } else {
+				if (classify(q) != TARY && classify(q) != TSTR) {
+				    error("Array type required for var parameter %s of %s",p1->symbol,p->symbol);
+				    goto conf_err;
+				}
+				/* check base type of array */
+				if (p2->type != q->type) {
+				    error("Base type of array not identical to that of conformant array parameter %s of %s", p1->symbol, p->symbol);
+				    goto conf_err;
+				}
+				if (p2->value[0] != q->value[0]) {
+				    error("Subscript number mismatch on conformant array parameter %s of %s", p1->symbol, p->symbol);
+				    /* Don't process array bounds & width */
+conf_err:			    if (p1->chain->type->class == CRANGE) {
+					d = p1->value[0];
+					for (i = 1; i <= d; i++) {
+					    /* for each subscript, pass by
+					     * bounds and width
+					     */
+					    p1 = p1->chain->chain->chain;
+					}
+				    }
+				    ptype = ctype = NLNIL;
+				    chk = FALSE;
+				    break;
+				}
+				/*
+				 * Save array type for all parameters with same
+				 * specification.
+				 */
+				ctype = q;
+				ptype = p2;
+				/*
+				 * If at end of conformant array list,
+				 * get bounds.
+				 */
+				if (p1->chain->type->class == CRANGE) {
+				    /* check each subscript, put on stack */
+				    d = ptype->value[0];
+				    q = ctype;
+				    for (i = 1; i <= d; i++) {
+					p1 = p1->chain;
+					q = q->chain;
+					if (incompat(q, p1->type, TR_NIL)){
+					    error("Subscript type not conformable with parameter %s of %s", p1->symbol, p->symbol);
+					    chk = FALSE;
+					    break;
+					}
+					/* Put lower and upper bound & width */
+#					ifdef OBJ
+					if (q->type->class == CRANGE) {
+					    putcbnds(q->type);
+					} else {
+					    put(2, width(p1->type) <= 2 ? O_CON2
+						: O_CON4, q->range[0]);
+					    put(2, width(p1->type) <= 2 ? O_CON2
+						: O_CON4, q->range[1]);
+					    put(2, width(p1->type) <= 2 ? O_CON2
+						: O_CON4, aryconst(ctype,i));
+					}
+#					endif OBJ
+#					ifdef PC
+					if (q->type->class == CRANGE) {
+					    for (j = 1; j <= 3; j++) {
+						p2 = p->nptr[j];
+						putRV(p2->symbol, (p2->nl_block
+						    & 037), p2->value[0],
+						    p2->extra_flags,p2type(p2));
+						putop(PCC_CM, PCCT_INT);
+					    }
+					} else {
+					    putleaf(PCC_ICON, q->range[0], 0,PCCT_INT,0);
+					    putop( PCC_CM , PCCT_INT );
+					    putleaf(PCC_ICON, q->range[1], 0,PCCT_INT,0);
+					    putop( PCC_CM , PCCT_INT );
+					    putleaf(PCC_ICON,aryconst(ctype,i),0,PCCT_INT,0);
+					    putop( PCC_CM , PCCT_INT );
+					}
+#					endif PC
+					p1 = p1->chain->chain;
+				    }
+				}
+			    }
 			}
 			break;
 		case VAR:
@@ -227,7 +359,8 @@ call(p, argv, porf, psbn)
 			 * Value parameter
 			 */
 #			ifdef OBJ
-			    q = rvalue(argv[1], p1->type , RREQ );
+			    q = rvalue(argv_node->list_node.list,
+					p1->type , RREQ );
 #			endif OBJ
 #			ifdef PC
 				/*
@@ -240,22 +373,26 @@ call(p, argv, porf, psbn)
 				case TREC:
 				case TSET:
 				case TSTR:
-				    q = stkrval( argv[1] , p1 -> type , LREQ );
+				q = stkrval(argv_node->list_node.list,
+						p1 -> type , (long) LREQ );
 				    break;
 				case TINT:
 				case TSCAL:
 				case TBOOL:
 				case TCHAR:
 				    precheck( p1 -> type , "_RANG4" , "_RSNG4" );
-				    q = stkrval( argv[1] , p1 -> type , RREQ );
+				q = stkrval(argv_node->list_node.list,
+						p1 -> type , (long) RREQ );
 				    postcheck(p1 -> type, nl+T4INT);
 				    break;
 				case TDOUBLE:
-				    q = stkrval( argv[1] , p1 -> type , RREQ );
-				    sconv(p2type(q), P2DOUBLE);
+				q = stkrval(argv_node->list_node.list,
+						p1 -> type , (long) RREQ );
+				    sconv(p2type(q), PCCT_DOUBLE);
 				    break;
 				default:
-				    q = rvalue( argv[1] , p1 -> type , RREQ );
+				    q = rvalue(argv_node->list_node.list,
+						p1 -> type , RREQ );
 				    break;
 			    }
 #			endif PC
@@ -263,7 +400,8 @@ call(p, argv, porf, psbn)
 				chk = FALSE;
 				break;
 			}
-			if (incompat(q, p1->type, argv[1])) {
+			if (incompat(q, p1->type,
+				argv_node->list_node.list)) {
 				cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
 				chk = FALSE;
 				break;
@@ -281,9 +419,9 @@ call(p, argv, porf, psbn)
 				case TREC:
 				case TSET:
 				case TSTR:
-					putstrop( P2STARG
+					putstrop( PCC_STARG
 					    , p2type( p1 -> type )
-					    , lwidth( p1 -> type )
+					    , (int) lwidth( p1 -> type )
 					    , align( p1 -> type ) );
 			    }
 #			endif PC
@@ -292,15 +430,22 @@ call(p, argv, porf, psbn)
 			/*
 			 * function parameter
 			 */
-			q = flvalue( (int *) argv[1] , p1 );
-			chk = (chk && fcompat(q, p1));
+			q = flvalue(argv_node->list_node.list, p1 );
+			/*chk = (chk && fcompat(q, p1));*/
+			if ((chk) && (fcompat(q, p1)))
+			    chk = TRUE;
+			else
+			    chk = FALSE;
 			break;
 		case FPROC:
 			/*
 			 * procedure parameter
 			 */
-			q = flvalue( (int *) argv[1] , p1 );
-			chk = (chk && fcompat(q, p1));
+			q = flvalue(argv_node->list_node.list, p1 );
+			/* chk = (chk && fcompat(q, p1)); */
+			if ((chk) && (fcompat(q, p1)))
+			    chk = TRUE;
+			else chk = FALSE;
 			break;
 		default:
 			panic("call");
@@ -313,27 +458,27 @@ call(p, argv, porf, psbn)
 		if ( noarguments ) {
 			noarguments = FALSE;
 		} else {
-			putop( P2LISTOP , P2INT );
+			putop( PCC_CM , PCCT_INT );
 		}
 #	    endif PC
-	    argv = argv[2];
+	    argv_node = argv_node->list_node.next;
 	}
-	if (argv != NIL) {
+	if (argv_node != TR_NIL) {
 		error("Too many arguments to %s", p->symbol);
-		rvlist(argv);
-		return (NIL);
+		rvlist(argv_node);
+		return (NLNIL);
 	}
 	if (chk == FALSE)
-		return NIL;
+		return NLNIL;
 #	ifdef OBJ
 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
-		put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]);
- 		put(2, O_LV | cbn << 8 + INDX ,
+		(void) put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]);
+ 		(void) put(2, O_LV | cbn << 8 + INDX ,
  			(int) savedispnp -> value[ NL_OFFS ] );
-		put(1, O_FCALL);
-		put(2, O_FRTN, even(width(p->type)));
+		(void) put(1, O_FCALL);
+		(void) put(2, O_FRTN, roundup(width(p->type), (long) A_STACK));
 	    } else {
-		put(2, O_CALL | psbn << 8, (long)p->value[NL_ENTLOC]);
+		(void) put(2, O_CALL | psbn << 8, (long)p->value[NL_ENTLOC]);
 	    }
 #	endif OBJ
 #	ifdef PC
@@ -345,15 +490,15 @@ call(p, argv, porf, psbn)
 		 *	space into which to save the display.
 		 */
 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
-		putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
-			tempdescrp -> extra_flags , P2PTR|P2STRTY );
+		putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
+			tempdescrp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
 		if ( !noarguments ) {
-		    putop( P2LISTOP , P2INT );
+		    putop( PCC_CM , PCCT_INT );
 		}
 		noarguments = FALSE;
- 		putLV( 0 , cbn , savedispnp -> value[ NL_OFFS ] ,
- 			savedispnp -> extra_flags , P2PTR | P2STRTY );
- 		putop( P2LISTOP , P2INT );
+ 		putLV((char *) 0 , cbn , savedispnp -> value[ NL_OFFS ] ,
+ 			savedispnp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
+ 		putop( PCC_CM , PCCT_INT );
 	    }
 		/*
 		 *	do the actual call:
@@ -369,52 +514,52 @@ call(p, argv, porf, psbn)
 		    case TSCAL:
 		    case TDOUBLE:
 		    case TPTR:
-			putop( ( noarguments ? P2UNARY P2CALL : P2CALL ) ,
-				p_type_p2type );
+			putop( ( noarguments ? PCCOM_UNARY PCC_CALL : PCC_CALL ) ,
+				(int) p_type_p2type );
 			if ( p -> class == FFUNC ) {
-			    putop( P2ASSIGN , p_type_p2type );
+			    putop( PCC_ASSIGN , (int) p_type_p2type );
 			}
 			break;
 		    default:
-			putstrop( ( noarguments ? P2UNARY P2STCALL : P2STCALL ),
-				ADDTYPE( p_type_p2type , P2PTR ) ,
-				p_type_width , p_type_align );
-			putstrop(P2STASG, ADDTYPE(p_type_p2type, P2PTR),
-				lwidth(p -> type), align(p -> type));
+			putstrop( ( noarguments ? PCCOM_UNARY PCC_STCALL : PCC_STCALL ),
+				(int) PCCM_ADDTYPE( p_type_p2type , PCCTM_PTR ) ,
+				(int) p_type_width ,(int) p_type_align );
+			putstrop(PCC_STASG, (int) PCCM_ADDTYPE(p_type_p2type, PCCTM_PTR),
+				(int) lwidth(p -> type), align(p -> type));
 			break;
 		}
 	    } else {
-		putop( ( noarguments ? P2UNARY P2CALL : P2CALL ) , P2INT );
+		putop( ( noarguments ? PCCOM_UNARY PCC_CALL : PCC_CALL ) , PCCT_INT );
 	    }
 		/*
 		 *	( t=p , ... , FRTN( t ) ...
 		 */
 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
-		putop( P2COMOP , P2INT );
-		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) ,
+		putop( PCC_COMOP , PCCT_INT );
+		putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) ,
 			"_FRTN" );
-		putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
-			tempdescrp -> extra_flags , P2PTR | P2STRTY );
- 		putLV( 0 , cbn , savedispnp -> value[ NL_OFFS ] ,
- 			savedispnp -> extra_flags , P2PTR | P2STRTY );
- 		putop( P2LISTOP , P2INT );
-		putop( P2CALL , P2INT );
-		putop( P2COMOP , P2INT );
+		putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
+			tempdescrp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
+ 		putLV((char *) 0 , cbn , savedispnp -> value[ NL_OFFS ] ,
+ 			savedispnp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
+ 		putop( PCC_CM , PCCT_INT );
+		putop( PCC_CALL , PCCT_INT );
+		putop( PCC_COMOP , PCCT_INT );
 	    }
 		/*
 		 *	if required:
 		 *	either	... , temp )
 		 *	or	... , &temp )
 		 */
-	    if ( porf == FUNC && temptype != P2UNDEF ) {
-		if ( temptype != P2STRTY ) {
-		    putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
-			    tempnlp -> extra_flags , p_type_p2type );
+	    if ( porf == FUNC && temptype != PCCT_UNDEF ) {
+		if ( temptype != PCCT_STRTY ) {
+		    putRV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
+			    tempnlp -> extra_flags , (int) p_type_p2type );
 		} else {
-		    putLV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
-			    tempnlp -> extra_flags , p_type_p2type );
+		    putLV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
+			    tempnlp -> extra_flags , (int) p_type_p2type );
 		}
-		putop( P2COMOP , P2INT );
+		putop( PCC_COMOP , PCCT_INT );
 	    }
 	    if ( porf == PROC ) {
 		putdot( filename , line );
@@ -424,11 +569,11 @@ call(p, argv, porf, psbn)
 }
 
 rvlist(al)
-	register int *al;
+	register struct tnode *al;
 {
 
-	for (; al != NIL; al = al[2])
-		rvalue( (int *) al[1], NLNIL , RREQ );
+	for (; al != TR_NIL; al = al->list_node.next)
+		(void) rvalue( al->list_node.list, NLNIL , RREQ );
 }
 
     /*
@@ -441,52 +586,56 @@ fcompat( formal , actual )
 {
     register struct nl	*f_chain;
     register struct nl	*a_chain;
+    extern struct nl	*plist();
     bool compat = TRUE;
 
-    if ( formal == NIL || actual == NIL ) {
+    if ( formal == NLNIL || actual == NLNIL ) {
 	return FALSE;
     }
     for (a_chain = plist(actual), f_chain = plist(formal);
-         f_chain != NIL;
+         f_chain != NLNIL;
 	 f_chain = f_chain->chain, a_chain = a_chain->chain) {
 	if (a_chain == NIL) {
 	    error("%s %s declared on line %d has more arguments than",
 		parnam(formal->class), formal->symbol,
-		linenum(formal));
+		(char *) linenum(formal));
 	    cerror("%s %s declared on line %d",
 		parnam(actual->class), actual->symbol,
-		linenum(actual));
+		(char *) linenum(actual));
 	    return FALSE;
 	}
 	if ( a_chain -> class != f_chain -> class ) {
 	    error("%s parameter %s of %s declared on line %d is not identical",
 		parnam(f_chain->class), f_chain->symbol,
-		formal->symbol, linenum(formal));
+		formal->symbol, (char *) linenum(formal));
 	    cerror("with %s parameter %s of %s declared on line %d",
 		parnam(a_chain->class), a_chain->symbol,
-		actual->symbol, linenum(actual));
+		actual->symbol, (char *) linenum(actual));
 	    compat = FALSE;
 	} else if (a_chain->class == FFUNC || a_chain->class == FPROC) {
-	    compat = (compat && fcompat(f_chain, a_chain));
+	    /*compat = (compat && fcompat(f_chain, a_chain));*/
+	    if ((compat) && (fcompat(f_chain, a_chain)))
+		compat = TRUE;
+	    else compat = FALSE;
 	}
 	if ((a_chain->class != FPROC && f_chain->class != FPROC) &&
 	    (a_chain->type != f_chain->type)) {
 	    error("Type of %s parameter %s of %s declared on line %d is not identical",
 		parnam(f_chain->class), f_chain->symbol,
-		formal->symbol, linenum(formal));
+		formal->symbol, (char *) linenum(formal));
 	    cerror("to type of %s parameter %s of %s declared on line %d",
 		parnam(a_chain->class), a_chain->symbol,
-		actual->symbol, linenum(actual));
+		actual->symbol, (char *) linenum(actual));
 	    compat = FALSE;
 	}
     }
     if (a_chain != NIL) {
 	error("%s %s declared on line %d has fewer arguments than",
 	    parnam(formal->class), formal->symbol,
-	    linenum(formal));
+	    (char *) linenum(formal));
 	cerror("%s %s declared on line %d",
 	    parnam(actual->class), actual->symbol,
-	    linenum(actual));
+	    (char *) linenum(actual));
 	return FALSE;
     }
     return compat;
@@ -512,7 +661,7 @@ parnam(nltype)
     }
 }
 
-plist(p)
+struct nl *plist(p)
     struct nl *p;
 {
     switch (p->class) {
@@ -523,7 +672,12 @@ plist(p)
 	case FUNC:
 	    return p->chain;
 	default:
-	    panic("plist");
+	    {
+		panic("plist");
+		return(NLNIL); /* this is here only so lint won't complain
+				  panic actually aborts */
+	    }
+
     }
 }