xref: /csrg-svn/usr.bin/pascal/src/flvalue.c (revision 22166)
1*22166Sdist /*
2*22166Sdist  * Copyright (c) 1980 Regents of the University of California.
3*22166Sdist  * All rights reserved.  The Berkeley software License Agreement
4*22166Sdist  * specifies the terms and conditions for redistribution.
5*22166Sdist  */
6910Speter 
714732Sthien #ifndef lint
8*22166Sdist static char sccsid[] = "@(#)flvalue.c	5.1 (Berkeley) 06/05/85";
9*22166Sdist #endif not lint
10910Speter 
11910Speter #include "whoami.h"
12910Speter #include "0.h"
13910Speter #include "tree.h"
14910Speter #include "opcode.h"
15910Speter #include "objfmt.h"
1614732Sthien #include "tree_ty.h"
17910Speter #ifdef PC
18910Speter #   include "pc.h"
1918459Sralph #   include <pcc.h>
20910Speter #endif PC
2111328Speter #include "tmps.h"
22910Speter 
23910Speter     /*
24910Speter      *	flvalue generates the code to either pass on a formal routine,
25910Speter      *	or construct the structure which is the environment for passing.
26910Speter      *	it tells the difference by looking at the tree it's given.
27910Speter      */
28910Speter struct nl *
291202Speter flvalue( r , formalp )
3014732Sthien     struct tnode *r; 	/* T_VAR */
311202Speter     struct nl	*formalp;
32910Speter     {
33910Speter 	struct nl	*p;
343826Speter 	struct nl	*tempnlp;
351202Speter 	char		*typename;
363364Speter #ifdef PC
373364Speter 	char		extname[ BUFSIZ ];
383364Speter #endif PC
39910Speter 
4014732Sthien 	if ( r == TR_NIL ) {
4114732Sthien 	    return NLNIL;
42910Speter 	}
431202Speter 	typename = formalp -> class == FFUNC ? "function":"procedure";
4414732Sthien 	if ( r->tag != T_VAR ) {
451202Speter 	    error("Expression given, %s required for %s parameter %s" ,
461202Speter 		    typename , typename , formalp -> symbol );
4714732Sthien 	    return NLNIL;
481202Speter 	}
4914732Sthien 	p = lookup(r->var_node.cptr);
5014732Sthien 	if (p == NLNIL) {
5114732Sthien 	    return NLNIL;
52910Speter 	}
531202Speter 	switch ( p -> class ) {
541202Speter 	    case FFUNC:
551202Speter 	    case FPROC:
5614732Sthien 		    if ( r->var_node.qual != TR_NIL ) {
571202Speter 			error("Formal %s %s cannot be qualified" ,
581202Speter 				typename , p -> symbol );
5914732Sthien 			return NLNIL;
60910Speter 		    }
61910Speter #		    ifdef OBJ
6214732Sthien 			(void) put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]);
63910Speter #		    endif OBJ
64910Speter #		    ifdef PC
65910Speter 			putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
663826Speter 				p -> extra_flags ,
67910Speter 				p2type( p ) );
68910Speter #		    endif PC
693298Smckusic 		    return p;
701202Speter 	    case FUNC:
711202Speter 	    case PROC:
7214732Sthien 		    if ( r->var_node.qual != TR_NIL ) {
731202Speter 			error("%s %s cannot be qualified" , typename ,
741202Speter 				p -> symbol );
7514732Sthien 			return NLNIL;
76910Speter 		    }
771202Speter 		    if (bn == 0) {
781202Speter 			error("Built-in %s %s cannot be passed as a parameter" ,
791202Speter 				typename , p -> symbol );
8014732Sthien 			return NLNIL;
81910Speter 		    }
82910Speter 			/*
833427Speter 			 *	allocate space for the thunk
84910Speter 			 */
8514732Sthien 		    tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG);
86910Speter #		    ifdef OBJ
8714732Sthien 			(void) put(2 , O_LV | cbn << 8 + INDX ,
883826Speter 				(int)tempnlp -> value[ NL_OFFS ] );
8914732Sthien 			(void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]);
90910Speter #		    endif OBJ
91910Speter #		    ifdef PC
9218459Sralph 			putleaf( PCC_ICON , 0 , 0 ,
9318459Sralph 			    PCCM_ADDTYPE( PCCTM_PTR , PCCM_ADDTYPE( PCCTM_FTN , PCCTM_PTR|PCCT_STRTY ) ) ,
94910Speter 			    "_FSAV" );
953427Speter 			sprintf( extname , "%s" , FORMALPREFIX );
963427Speter 			sextname( &extname[ strlen( extname ) ] ,
973427Speter 				    p -> symbol , bn );
9818459Sralph 			putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
9918459Sralph 			putleaf( PCC_ICON , bn , 0 , PCCT_INT , (char *) 0 );
10018459Sralph 			putop( PCC_CM , PCCT_INT );
10114732Sthien 			putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] ,
10218459Sralph 				tempnlp -> extra_flags , PCCT_STRTY );
10318459Sralph 			putop( PCC_CM , PCCT_INT );
10418459Sralph 			putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );
105910Speter #		    endif PC
1063298Smckusic 		    return p;
107910Speter 	    default:
1081202Speter 		    error("Variable given, %s required for %s parameter %s" ,
1091202Speter 			    typename , typename , formalp -> symbol );
11014732Sthien 		    return NLNIL;
111910Speter 	}
112910Speter     }
113