2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/flvalue.c

   1: /*
   2:  * Copyright (c) 1980 Regents of the University of California.
   3:  * All rights reserved.  The Berkeley software License Agreement
   4:  * specifies the terms and conditions for redistribution.
   5:  */
   6: 
   7: #ifndef lint
   8: static char sccsid[] = "@(#)flvalue.c	5.1 (Berkeley) 6/5/85";
   9: #endif not lint
  10: 
  11: #include "whoami.h"
  12: #include "0.h"
  13: #include "tree.h"
  14: #include "opcode.h"
  15: #include "objfmt.h"
  16: #include "tree_ty.h"
  17: #ifdef PC
  18: #   include "pc.h"
  19: #   include <pcc.h>
  20: #endif PC
  21: #include "tmps.h"
  22: 
  23:     /*
  24:      *	flvalue generates the code to either pass on a formal routine,
  25:      *	or construct the structure which is the environment for passing.
  26:      *	it tells the difference by looking at the tree it's given.
  27:      */
  28: struct nl *
  29: flvalue( r , formalp )
  30:     struct tnode *r;    /* T_VAR */
  31:     struct nl   *formalp;
  32:     {
  33:     struct nl   *p;
  34:     struct nl   *tempnlp;
  35:     char        *typename;
  36: #ifdef PC
  37:     char        extname[ BUFSIZ ];
  38: #endif PC
  39: 
  40:     if ( r == TR_NIL ) {
  41:         return NLNIL;
  42:     }
  43:     typename = formalp -> class == FFUNC ? "function":"procedure";
  44:     if ( r->tag != T_VAR ) {
  45:         error("Expression given, %s required for %s parameter %s" ,
  46:             typename , typename , formalp -> symbol );
  47:         return NLNIL;
  48:     }
  49:     p = lookup(r->var_node.cptr);
  50:     if (p == NLNIL) {
  51:         return NLNIL;
  52:     }
  53:     switch ( p -> class ) {
  54:         case FFUNC:
  55:         case FPROC:
  56:             if ( r->var_node.qual != TR_NIL ) {
  57:             error("Formal %s %s cannot be qualified" ,
  58:                 typename , p -> symbol );
  59:             return NLNIL;
  60:             }
  61: #		    ifdef OBJ
  62:             (void) put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]);
  63: #		    endif OBJ
  64: #		    ifdef PC
  65:             putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
  66:                 p -> extra_flags ,
  67:                 p2type( p ) );
  68: #		    endif PC
  69:             return p;
  70:         case FUNC:
  71:         case PROC:
  72:             if ( r->var_node.qual != TR_NIL ) {
  73:             error("%s %s cannot be qualified" , typename ,
  74:                 p -> symbol );
  75:             return NLNIL;
  76:             }
  77:             if (bn == 0) {
  78:             error("Built-in %s %s cannot be passed as a parameter" ,
  79:                 typename , p -> symbol );
  80:             return NLNIL;
  81:             }
  82:             /*
  83: 			 *	allocate space for the thunk
  84: 			 */
  85:             tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG);
  86: #		    ifdef OBJ
  87:             (void) put(2 , O_LV | cbn << 8 + INDX ,
  88:                 (int)tempnlp -> value[ NL_OFFS ] );
  89:             (void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]);
  90: #		    endif OBJ
  91: #		    ifdef PC
  92:             putleaf( PCC_ICON , 0 , 0 ,
  93:                 PCCM_ADDTYPE( PCCTM_PTR , PCCM_ADDTYPE( PCCTM_FTN , PCCTM_PTR|PCCT_STRTY ) ) ,
  94:                 "_FSAV" );
  95:             sprintf( extname , "%s" , FORMALPREFIX );
  96:             sextname( &extname[ strlen( extname ) ] ,
  97:                     p -> symbol , bn );
  98:             putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
  99:             putleaf( PCC_ICON , bn , 0 , PCCT_INT , (char *) 0 );
 100:             putop( PCC_CM , PCCT_INT );
 101:             putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] ,
 102:                 tempnlp -> extra_flags , PCCT_STRTY );
 103:             putop( PCC_CM , PCCT_INT );
 104:             putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );
 105: #		    endif PC
 106:             return p;
 107:         default:
 108:             error("Variable given, %s required for %s parameter %s" ,
 109:                 typename , typename , formalp -> symbol );
 110:             return NLNIL;
 111:     }
 112:     }

Defined functions

Defined variables