xref: /csrg-svn/usr.bin/pascal/src/flvalue.c (revision 3364)
1 /* Copyright (c) 1980 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)flvalue.c 1.8 03/24/81";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "tree.h"
8 #include "opcode.h"
9 #include "objfmt.h"
10 #ifdef PC
11 #   include "pc.h"
12 #   include "pcops.h"
13 #endif PC
14 #ifdef OBJ
15 /*
16  * runtime display structure
17  */
18 struct dispsave {
19 	char *locvars;		/* pointer to local variables */
20 	struct stack *stp;	/* pointer to local stack frame */
21 };
22 #endif OBJ
23 
24     /*
25      *	flvalue generates the code to either pass on a formal routine,
26      *	or construct the structure which is the environment for passing.
27      *	it tells the difference by looking at the tree it's given.
28      */
29 struct nl *
30 flvalue( r , formalp )
31     int		*r;
32     struct nl	*formalp;
33     {
34 	struct nl	*p;
35 	long		tempoff;
36 	char		*typename;
37 #ifdef PC
38 	char		extname[ BUFSIZ ];
39 #endif PC
40 
41 	if ( r == NIL ) {
42 	    return NIL;
43 	}
44 	typename = formalp -> class == FFUNC ? "function":"procedure";
45 	if ( r[0] != T_VAR ) {
46 	    error("Expression given, %s required for %s parameter %s" ,
47 		    typename , typename , formalp -> symbol );
48 	    return NIL;
49 	}
50 	p = lookup(r[2]);
51 	if (p == NIL) {
52 	    return NIL;
53 	}
54 	switch ( p -> class ) {
55 	    case FFUNC:
56 	    case FPROC:
57 		    if ( r[3] != NIL ) {
58 			error("Formal %s %s cannot be qualified" ,
59 				typename , p -> symbol );
60 			return NIL;
61 		    }
62 #		    ifdef OBJ
63 			put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]);
64 #		    endif OBJ
65 #		    ifdef PC
66 			putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
67 				p2type( p ) );
68 #		    endif PC
69 		    return p;
70 	    case FUNC:
71 	    case PROC:
72 		    if ( r[3] != NIL ) {
73 			error("%s %s cannot be qualified" , typename ,
74 				p -> symbol );
75 			return NIL;
76 		    }
77 		    if (bn == 0) {
78 			error("Built-in %s %s cannot be passed as a parameter" ,
79 				typename , p -> symbol );
80 			return NIL;
81 		    }
82 			/*
83 			 *	formal routine structure:
84 			 *
85 			 *	struct formalrtn {
86 			 *		long		(*entryaddr)();
87 			 *		long		cbn;
88 			 *		struct dispsave	disp[2*MAXLVL];
89 			 *	};
90 			 */
91 		    tempoff = tmpalloc(sizeof (long (*)()) + sizeof (long)
92 			+ 2*bn*sizeof (struct dispsave), nl+TSTR, NOREG);
93 #		    ifdef OBJ
94 			put(2 , O_LV | cbn << 8 + INDX , (int)tempoff );
95 			put(2, O_FSAV | bn << 8, (long)p->entloc);
96 #		    endif OBJ
97 #		    ifdef PC
98 			putleaf( P2ICON , 0 , 0 ,
99 			    ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) ,
100 			    "_FSAV" );
101 			sextname( extname , p -> symbol , bn );
102 			putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
103 			putleaf( P2ICON , bn , 0 , P2INT , 0 );
104 			putop( P2LISTOP , P2INT );
105 			putLV( 0 , cbn , tempoff , P2STRTY );
106 			putop( P2LISTOP , P2INT );
107 			putop( P2CALL , P2PTR | P2STRTY );
108 #		    endif PC
109 		    return p;
110 	    default:
111 		    error("Variable given, %s required for %s parameter %s" ,
112 			    typename , typename , formalp -> symbol );
113 		    return NIL;
114 	}
115     }
116