4.4BSD/usr/src/usr.bin/pascal/src/fdec.c
/*-
* Copyright (c) 1980, 1993
* The Regents of the University of California. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
#ifndef lint
static char sccsid[] = "@(#)fdec.c 8.1 (Berkeley) 6/6/93";
#endif /* not lint */
#include "whoami.h"
#include "0.h"
#include "tree.h"
#include "opcode.h"
#include "objfmt.h"
#include "align.h"
#include "tmps.h"
/*
* this array keeps the pxp counters associated with
* functions and procedures, so that they can be output
* when their bodies are encountered
*/
int bodycnts[ DSPLYSZ ];
#ifdef PC
# include "pc.h"
# include <pcc.h>
#endif PC
#ifdef OBJ
int cntpatch;
int nfppatch;
#endif OBJ
funcfwd(fp)
struct nl *fp;
{
/*
* save the counter for this function
*/
if ( monflg ) {
fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
}
}
/*
* Funcext marks the procedure or
* function external in the symbol
* table. Funcext should only be
* called if PC, and is an error
* otherwise.
*/
struct nl *
funcext(fp)
struct nl *fp;
{
#ifdef OBJ
error("Procedures or functions cannot be declared external.");
#endif OBJ
#ifdef PC
/*
* save the counter for this function
*/
if ( monflg ) {
fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
}
if (opt('s')) {
standard();
error("External procedures and functions are not standard");
} else {
if (cbn == 1) {
fp->extra_flags |= NEXTERN;
stabefunc( fp -> symbol , fp -> class , line );
}
else
error("External procedures and functions can only be declared at the outermost level.");
}
#endif PC
return(fp);
}
/*
* Funcbody is called
* when the actual (resolved)
* declaration of a procedure is
* encountered. It puts the names
* of the (function) and parameters
* into the symbol table.
*/
struct nl *
funcbody(fp)
struct nl *fp;
{
register struct nl *q;
cbn++;
if (cbn >= DSPLYSZ) {
error("Too many levels of function/procedure nesting");
pexit(ERRS);
}
tmpinit(cbn);
gotos[cbn] = NIL;
errcnt[cbn] = syneflg;
parts[ cbn ] = NIL;
dfiles[ cbn ] = FALSE;
if (fp == NIL)
return (NIL);
/*
* Save the virtual name
* list stack pointer so
* the space can be freed
* later (funcend).
*/
fp->ptr[2] = nlp;
if (fp->class != PROG) {
for (q = fp->chain; q != NIL; q = q->chain) {
(void) enter(q);
# ifdef PC
q -> extra_flags |= NPARAM;
# endif PC
}
}
if (fp->class == FUNC) {
/*
* For functions, enter the fvar
*/
(void) enter(fp->ptr[NL_FVAR]);
# ifdef PC
q = fp -> ptr[ NL_FVAR ];
if (q -> type != NIL ) {
sizes[cbn].curtmps.om_off = q -> value[NL_OFFS];
sizes[cbn].om_max = q -> value[NL_OFFS];
}
# endif PC
}
# ifdef PTREE
/*
* pick up the pointer to porf declaration
*/
PorFHeader[ ++nesting ] = fp -> inTree;
# endif PTREE
return (fp);
}
/*
* Segend is called to check for
* unresolved variables, funcs and
* procs, and deliver unresolved and
* baduse error diagnostics at the
* end of a routine segment (a separately
* compiled segment that is not the
* main program) for PC. This
* routine should only be called
* by PC (not standard).
*/
segend()
{
#ifdef PC
register struct nl *p;
register int i,b;
char *cp;
if ( monflg ) {
error("Only the module containing the \"program\" statement");
cerror("can be profiled with ``pxp''.\n");
}
if (opt('s')) {
standard();
error("Separately compiled routine segments are not standard.");
} else {
b = cbn;
for (i=0; i<077; i++) {
for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
switch (p->class) {
case BADUSE:
cp = "s";
if (((struct udinfo *) (p->chain))->ud_next == NIL)
cp++;
eholdnl();
if (p->value[NL_KINDS] & ISUNDEF)
nerror("%s undefined on line%s", p->symbol, cp);
else
nerror("%s improperly used on line%s", p->symbol, cp);
pnumcnt = 10;
pnums((struct udinfo *) (p->chain));
pchr('\n');
break;
case FUNC:
case PROC:
if ((p->nl_flags & NFORWD) &&
((p->extra_flags & NEXTERN) == 0))
nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
break;
case FVAR:
if (((p->nl_flags & NMOD) == 0) &&
((p->chain->extra_flags & NEXTERN) == 0))
nerror("No assignment to the function variable");
break;
}
}
disptab[i] = p;
}
}
#endif PC
#ifdef OBJ
error("Missing program statement and program body");
#endif OBJ
}
/*
* Level1 does level one processing for
* separately compiled routine segments
*/
level1()
{
# ifdef OBJ
error("Missing program statement");
# endif OBJ
# ifdef PC
if (opt('s')) {
standard();
error("Missing program statement");
}
# endif PC
cbn++;
tmpinit(cbn);
gotos[cbn] = NIL;
errcnt[cbn] = syneflg;
parts[ cbn ] = NIL;
dfiles[ cbn ] = FALSE;
progseen = TRUE;
}
pnums(p)
struct udinfo *p;
{
if (p->ud_next != NIL)
pnums(p->ud_next);
if (pnumcnt == 0) {
printf("\n\t");
pnumcnt = 20;
}
pnumcnt--;
printf(" %d", p->ud_line);
}
/*VARARGS*/
nerror(a1, a2, a3)
char *a1,*a2,*a3;
{
if (Fp != NIL) {
yySsync();
#ifndef PI1
if (opt('l'))
yyoutline();
#endif
yysetfile(filename);
printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
Fp = NIL;
elineoff();
}
error(a1, a2, a3);
}