2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/fdec.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[] = "@(#)fdec.c	5.1 (Berkeley) 6/5/85";
   9: #endif not lint
  10: 
  11: 
  12: #include "whoami.h"
  13: #include "0.h"
  14: #include "tree.h"
  15: #include "opcode.h"
  16: #include "objfmt.h"
  17: #include "align.h"
  18: #include "tmps.h"
  19: 
  20: /*
  21:  * this array keeps the pxp counters associated with
  22:  * functions and procedures, so that they can be output
  23:  * when their bodies are encountered
  24:  */
  25: int bodycnts[ DSPLYSZ ];
  26: 
  27: #ifdef PC
  28: #   include "pc.h"
  29: #   include <pcc.h>
  30: #endif PC
  31: 
  32: #ifdef OBJ
  33: int cntpatch;
  34: int nfppatch;
  35: #endif OBJ
  36: 
  37: funcfwd(fp)
  38:     struct nl *fp;
  39: {
  40: 
  41:         /*
  42: 	     *	save the counter for this function
  43: 	     */
  44:     if ( monflg ) {
  45:         fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
  46:     }
  47: }
  48: 
  49: /*
  50:  * Funcext marks the procedure or
  51:  * function external in the symbol
  52:  * table. Funcext should only be
  53:  * called if PC, and is an error
  54:  * otherwise.
  55:  */
  56: 
  57: struct nl *
  58: funcext(fp)
  59:     struct nl *fp;
  60: {
  61: 
  62: #ifdef OBJ
  63:     error("Procedures or functions cannot be declared external.");
  64: #endif OBJ
  65: 
  66: #ifdef PC
  67:         /*
  68: 	     *	save the counter for this function
  69: 	     */
  70:     if ( monflg ) {
  71:         fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
  72:     }
  73:     if (opt('s')) {
  74:         standard();
  75:         error("External procedures and functions are not standard");
  76:     } else {
  77:         if (cbn == 1) {
  78:             fp->extra_flags |= NEXTERN;
  79:             stabefunc( fp -> symbol , fp -> class , line );
  80:         }
  81:         else
  82:             error("External procedures and functions can only be declared at the outermost level.");
  83:     }
  84: #endif PC
  85: 
  86:     return(fp);
  87: }
  88: 
  89: /*
  90:  * Funcbody is called
  91:  * when the actual (resolved)
  92:  * declaration of a procedure is
  93:  * encountered. It puts the names
  94:  * of the (function) and parameters
  95:  * into the symbol table.
  96:  */
  97: struct nl *
  98: funcbody(fp)
  99:     struct nl *fp;
 100: {
 101:     register struct nl *q;
 102: 
 103:     cbn++;
 104:     if (cbn >= DSPLYSZ) {
 105:         error("Too many levels of function/procedure nesting");
 106:         pexit(ERRS);
 107:     }
 108:     tmpinit(cbn);
 109:     gotos[cbn] = NIL;
 110:     errcnt[cbn] = syneflg;
 111:     parts[ cbn ] = NIL;
 112:     dfiles[ cbn ] = FALSE;
 113:     if (fp == NIL)
 114:         return (NIL);
 115:     /*
 116: 	 * Save the virtual name
 117: 	 * list stack pointer so
 118: 	 * the space can be freed
 119: 	 * later (funcend).
 120: 	 */
 121:     fp->ptr[2] = nlp;
 122:     if (fp->class != PROG) {
 123:         for (q = fp->chain; q != NIL; q = q->chain) {
 124:             (void) enter(q);
 125: #			ifdef PC
 126:                 q -> extra_flags |= NPARAM;
 127: #			endif PC
 128:         }
 129:     }
 130:     if (fp->class == FUNC) {
 131:         /*
 132: 		 * For functions, enter the fvar
 133: 		 */
 134:         (void) enter(fp->ptr[NL_FVAR]);
 135: #		ifdef PC
 136:             q = fp -> ptr[ NL_FVAR ];
 137:             if (q -> type != NIL ) {
 138:             sizes[cbn].curtmps.om_off = q -> value[NL_OFFS];
 139:             sizes[cbn].om_max = q -> value[NL_OFFS];
 140:             }
 141: #		endif PC
 142:     }
 143: #	ifdef PTREE
 144:         /*
 145: 		 *	pick up the pointer to porf declaration
 146: 		 */
 147:         PorFHeader[ ++nesting ] = fp -> inTree;
 148: #	endif PTREE
 149:     return (fp);
 150: }
 151: 
 152: /*
 153:  * Segend is called to check for
 154:  * unresolved variables, funcs and
 155:  * procs, and deliver unresolved and
 156:  * baduse error diagnostics at the
 157:  * end of a routine segment (a separately
 158:  * compiled segment that is not the
 159:  * main program) for PC. This
 160:  * routine should only be called
 161:  * by PC (not standard).
 162:  */
 163:  segend()
 164:  {
 165: #ifdef PC
 166:     register struct nl *p;
 167:     register int i,b;
 168:     char *cp;
 169: 
 170:     if ( monflg ) {
 171:         error("Only the module containing the \"program\" statement");
 172:         cerror("can be profiled with ``pxp''.\n");
 173:     }
 174:     if (opt('s')) {
 175:         standard();
 176:         error("Separately compiled routine segments are not standard.");
 177:     } else {
 178:         b = cbn;
 179:         for (i=0; i<077; i++) {
 180:             for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
 181:             switch (p->class) {
 182:                 case BADUSE:
 183:                     cp = "s";
 184:                     if (((struct udinfo *) (p->chain))->ud_next == NIL)
 185:                         cp++;
 186:                     eholdnl();
 187:                     if (p->value[NL_KINDS] & ISUNDEF)
 188:                         nerror("%s undefined on line%s", p->symbol, cp);
 189:                     else
 190:                         nerror("%s improperly used on line%s", p->symbol, cp);
 191:                     pnumcnt = 10;
 192:                     pnums((struct udinfo *) (p->chain));
 193:                     pchr('\n');
 194:                     break;
 195: 
 196:                 case FUNC:
 197:                 case PROC:
 198:                     if ((p->nl_flags & NFORWD) &&
 199:                         ((p->extra_flags & NEXTERN) == 0))
 200:                         nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
 201:                     break;
 202: 
 203:                 case FVAR:
 204:                     if (((p->nl_flags & NMOD) == 0) &&
 205:                         ((p->chain->extra_flags & NEXTERN) == 0))
 206:                         nerror("No assignment to the function variable");
 207:                     break;
 208:                 }
 209:                }
 210:                disptab[i] = p;
 211:             }
 212:     }
 213: #endif PC
 214: #ifdef OBJ
 215:     error("Missing program statement and program body");
 216: #endif OBJ
 217: 
 218: }
 219: 
 220: 
 221: /*
 222:  * Level1 does level one processing for
 223:  * separately compiled routine segments
 224:  */
 225: level1()
 226: {
 227: 
 228: #	ifdef OBJ
 229:         error("Missing program statement");
 230: #	endif OBJ
 231: #	ifdef PC
 232:         if (opt('s')) {
 233:             standard();
 234:             error("Missing program statement");
 235:         }
 236: #	endif PC
 237: 
 238:     cbn++;
 239:     tmpinit(cbn);
 240:     gotos[cbn] = NIL;
 241:     errcnt[cbn] = syneflg;
 242:     parts[ cbn ] = NIL;
 243:     dfiles[ cbn ] = FALSE;
 244:     progseen = TRUE;
 245: }
 246: 
 247: 
 248: 
 249: pnums(p)
 250:     struct udinfo *p;
 251: {
 252: 
 253:     if (p->ud_next != NIL)
 254:         pnums(p->ud_next);
 255:     if (pnumcnt == 0) {
 256:         printf("\n\t");
 257:         pnumcnt = 20;
 258:     }
 259:     pnumcnt--;
 260:     printf(" %d", p->ud_line);
 261: }
 262: 
 263: /*VARARGS*/
 264: nerror(a1, a2, a3)
 265:     char *a1,*a2,*a3;
 266: {
 267: 
 268:     if (Fp != NIL) {
 269:         yySsync();
 270: #ifndef PI1
 271:         if (opt('l'))
 272:             yyoutline();
 273: #endif
 274:         yysetfile(filename);
 275:         printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
 276:         Fp = NIL;
 277:         elineoff();
 278:     }
 279:     error(a1, a2, a3);
 280: }

Defined functions

Defined variables