From 81504920ba36530974741adf769355ffb6a38884 Mon Sep 17 00:00:00 2001 From: "Peter B. Kessler" Date: Thu, 28 Aug 1980 02:54:40 -0800 Subject: [PATCH] date and time created 80/08/27 19:54:40 by peter SCCS-vsn: usr.bin/pascal/src/call.c 1.1 --- usr/src/usr.bin/pascal/src/call.c | 249 ++++++++++++++++++++++++++++++ 1 file changed, 249 insertions(+) create mode 100644 usr/src/usr.bin/pascal/src/call.c diff --git a/usr/src/usr.bin/pascal/src/call.c b/usr/src/usr.bin/pascal/src/call.c new file mode 100644 index 0000000000..53007e897c --- /dev/null +++ b/usr/src/usr.bin/pascal/src/call.c @@ -0,0 +1,249 @@ +/* Copyright (c) 1979 Regents of the University of California */ + +static char sccsid[] = "@(#)call.c 1.1 %G%"; + +#include "whoami.h" +#include "0.h" +#include "tree.h" +#include "opcode.h" +#include "objfmt.h" +#ifdef PC +# include "pc.h" +# include "pcops.h" +#endif PC + +/* + * Call generates code for calls to + * user defined procedures and functions + * and is called by proc and funccod. + * P is the result of the lookup + * of the procedure/function symbol, + * and porf is PROC or FUNC. + * Psbn is the block number of p. + */ +struct nl * +call(p, argv, porf, psbn) + struct nl *p; + int *argv, porf, psbn; +{ + register struct nl *p1, *q; + int *r; + +# ifdef PC + long temp; + int firsttime; + int rettype; +# endif PC + +# ifdef OBJ + if (porf == FUNC) + /* + * Push some space + * for the function return type + */ + put2(O_PUSH, even(-width(p->type))); +# endif OBJ +# ifdef PC + if ( porf == FUNC ) { + switch( classify( p -> type ) ) { + case TSTR: + case TSET: + case TREC: + case TFILE: + case TARY: + temp = sizes[ cbn ].om_off -= width( p -> type ); + putlbracket( ftnno , -sizes[cbn].om_off ); + if (sizes[cbn].om_off < sizes[cbn].om_max) { + sizes[cbn].om_max = sizes[cbn].om_off; + } + putRV( 0 , cbn , temp , P2STRTY ); + } + } + { + 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 ); + } + 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 + */ +# ifdef OBJ + 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 ); + break; + /* + * and fall through + */ + default: + q = rvalue( argv[1] , p1 -> type , RREQ ); + 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); +# 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 ) ); + } +# 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 ); + } +# endif PC + argv = argv[2]; + } + if (argv != NIL) { + error("Too many arguments to %s", p->symbol); + rvlist(argv); + return (NIL); + } +# ifdef OBJ + put2(O_CALL | psbn << 8+INDX, p->entloc); + put2(O_POP, p->value[NL_OFFS]-DPOFF2); +# endif OBJ +# ifdef PC + if ( porf == FUNC ) { + rettype = p2type( p -> type ); + switch ( classify( p -> type ) ) { + case TBOOL: + case TCHAR: + case TINT: + case TSCAL: + case TDOUBLE: + case TPTR: + if ( p -> chain == NIL ) { + putop( P2UNARY P2CALL , rettype ); + } else { + putop( P2CALL , rettype ); + } + break; + default: + if ( p -> chain == NIL ) { + putstrop( P2UNARY P2STCALL + , ADDTYPE( rettype , P2PTR ) + , lwidth( p -> type ) + , align( p -> type ) ); + } else { + putstrop( P2STCALL + , ADDTYPE( rettype , P2PTR ) + , lwidth( p -> type ) + , align( p -> type ) ); + } + putstrop( P2STASG , rettype , lwidth( p -> type ) + , align( p -> type ) ); + putLV( 0 , cbn , temp , rettype ); + putop( P2COMOP , P2INT ); + break; + } + } else { + if ( p -> chain == NIL ) { + putop( P2UNARY P2CALL , P2INT ); + } else { + putop( P2CALL , P2INT ); + } + putdot( filename , line ); + } +# endif PC + return (p->type); +} + +rvlist(al) + register int *al; +{ + + for (; al != NIL; al = al[2]) + rvalue( (int *) al[1], NLNIL , RREQ ); +} -- 2.20.1