exec.c File Reference

#include "defs.h"
#include "p1defs.h"
#include "names.h"

Include dependency graph for exec.c:

Go to the source code of this file.

Defines
#define	DOINIT   par[0]
#define	DOLIMIT   par[1]
#define	DOINCR   par[2]
#define	VARSTEP   0
#define	POSSTEP   1
#define	NEGSTEP   2
Functions
static void exar2	Argdcl ((int, tagptr, struct Labelblock *, struct Labelblock *))
static void popctl	Argdcl ((void))
static void pushctl	Argdcl ((int))
void	exif (expptr p)
void	exelif (expptr p)
void	exelse (Void)
void	exendif ()
void	new_endif ()
LOCAL void	pushctl (int code)
LOCAL void	popctl (Void)
LOCAL void	poplab (Void)
void	exgoto (struct Labelblock *lab)
static expptr	cktype1 (expptr p)
void	exequals (register struct Primblock *lp, register expptr rp)
void	mkstfunct (struct Primblock *lp, expptr rp)
static void	mixed_type (Namep np)
void	excall (Namep name, struct Listblock *args, int nstars, struct Labelblock **labels)
void	exstop (int stop, register expptr p)
void	exdo (int range, Namep loopname, chainp spec)
void	exenddo (Namep np)
void	enddo (int here)
void	exassign (register Namep vname, struct Labelblock *labelval)
void	exarif (expptr expr, struct Labelblock *neglab, struct Labelblock *zerlab, struct Labelblock *poslab)
LOCAL void	exar2 (int op, expptr e, struct Labelblock *l1, struct Labelblock *l2)
void	exreturn (register expptr p)
void	exasgoto (Namep labvar)
Variables
long	laststfcn = -1
long	thisstno
int	doing_stmtfcn

---

Define Documentation

#define DOINCR   par[2]

Definition at line 449 of file exec.c.

Referenced by exdo().

#define DOINIT   par[0]

Definition at line 447 of file exec.c.

Referenced by exdo().

#define DOLIMIT   par[1]

Definition at line 448 of file exec.c.

Referenced by exdo().

#define NEGSTEP   2

Definition at line 456 of file exec.c.

Referenced by exdo().

#define POSSTEP   1

Definition at line 455 of file exec.c.

Referenced by exdo().

#define VARSTEP   0

Definition at line 454 of file exec.c.

Referenced by exdo().

---

Function Documentation

static void pushctl Argdcl

(

(int)

)

[static]

static void popctl Argdcl

(

(void)

)

[static]

static void exar2 Argdcl

(

(int, tagptr, struct Labelblock *, struct Labelblock *)

)

[static]

static expptr cktype1

(

expptr

p

)

[static]

Definition at line 191 of file exec.c.

References badtag(), Chain::datap, Primblock::fcharp, free(), mkexpr(), Chain::nextp, p, Expression::primblock, t, TADDR, TCONST, TERROR, TEXPR, TLIST, and TPRIM.

Referenced by exequals().

{
        /* Do things omitted because we might have been parsing a */
        /* statement function...  Check types and fold constants. */

        chainp c;
        tagptr t;

        if(p == 0)
                return(0);

        switch(p->tag) {
          case TCONST:
          case TADDR:
          case TERROR:
                break;

/* This case means that   fixexpr   can't call   fixtype   with any expr,
   only a subexpr of its parameter. */

          case TEXPR:
                t = mkexpr(p->exprblock.opcode, cktype1(p->exprblock.leftp),
                                cktype1(p->exprblock.rightp));
                free((charptr)p);
                p = (expptr) t;
                break;

          case TLIST:
                for(c = p->listblock.listp; c; c = c->nextp)
                        c->datap = (char*)cktype1((expptr)c->datap);
                break;

          case TPRIM:
                p->primblock.argsp = (struct Listblock*)
                        cktype1((expptr)p->primblock.argsp);
                p->primblock.fcharp = cktype1(p->primblock.fcharp);
                p->primblock.lcharp = cktype1(p->primblock.lcharp);
                break;

          default:
                badtag("cktype1", p->tag);
          }
        return p;
        }

Here is the call graph for this function:

Here is the caller graph for this function:

void enddo

(

int

here

)

Definition at line 716 of file exec.c.

References Expression::addrblock, Ctlframe::ctlabels, CTLDO, ctls, ctlstack, Ctlframe::ctltype, deregister(), Ctlframe::doinit, Ctlframe::dolabel, Ctlframe::domax, Ctlframe::donamep, dorange, Ctlframe::dostep, Ctlframe::dowhile, frexpr(), frtemp(), i, Addrblock::istemp, memversion(), mkplace(), NO, p1for_end(), popctl(), poplab(), puteq(), TADDR, Expression::tag, and Nameblock::vdovar.

Referenced by doiolist(), and yyparse().

{
        register struct Ctlframe *q;
        Namep np;                       /* name of the current DO index */
        Addrp ap;
        register int i;
        register expptr e;

/* Many DO's can end at the same statement, so keep looping over all
   nested indicies */

        while(here == dorange)
        {
                if(np = ctlstack->donamep)
                        {
                        p1for_end ();

/* Now we're done with all of the tests, and the loop has terminated.
   Store the index value back in long-term memory */

                        if(ap = memversion(np))
                                puteq((expptr)ap, (expptr)mkplace(np));
                        for(i = 0 ; i < 4 ; ++i)
                                ctlstack->ctlabels[i] = 0;
                        deregister(ctlstack->donamep);
                        ctlstack->donamep->vdovar = NO;
                        /* ctlstack->dostep and ctlstack->domax can be zero */
                        /* with sufficiently bizarre (erroneous) syntax */
                        if (e = ctlstack->dostep)
                                if (e->tag == TADDR && e->addrblock.istemp)
                                        frtemp((Addrp)e);
                                else
                                        frexpr(e);
                        if (e = ctlstack->domax)
                                if (e->tag == TADDR && e->addrblock.istemp)
                                        frtemp((Addrp)e);
                                else
                                        frexpr(e);
                        if (e = ctlstack->doinit)
                                frtemp((Addrp)e);
                        }
                else if (ctlstack->dowhile)
                        p1for_end ();

/* Set   dorange   to the closing label of the next most enclosing DO loop
   */

                popctl();
                poplab();
                dorange = 0;
                for(q = ctlstack ; q>=ctls ; --q)
                        if(q->ctltype == CTLDO)
                        {
                                dorange = q->dolabel;
                                break;
                        }
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void exar2	(	int	op,
		expptr	e,
		struct Labelblock *	l1,
		struct Labelblock *	l2
	)

Definition at line 925 of file exec.c.

References comp, exgoto(), fixtype(), ICON, mkexpr(), p1_else(), p1_if(), p1else_end(), and putx().

Referenced by exarif().

{
        expptr comp;

        comp = mkexpr (op, e, ICON (0));
        p1_if(putx(fixtype(comp)));
        exgoto(l1);
        p1_else ();
        exgoto(l2);
        p1else_end ();
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exarif	(	expptr	expr,
		struct Labelblock *	neglab,
		struct Labelblock *	zerlab,
		struct Labelblock *	poslab
	)

Definition at line 866 of file exec.c.

References addressable(), cpexpr(), ENULL, err, exar2(), exgoto(), expr(), fixtype(), frexpr(), ICON, lp, mkexpr(), mktmp(), MSKINT, MSKREAL, ONEOF, OPASSIGN, OPEQ, OPGE, OPLE, OPLT, OPNE, p1_elif(), p1_else(), p1_if(), p1else_end(), putx(), Labelblock::stateno, and t.

Referenced by yyparse().

{
    ftnint lm, lz, lp;

    lm = neglab->stateno;
    lz = zerlab->stateno;
    lp = poslab->stateno;
    expr = fixtype(expr);

    if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) )
    {
        err("invalid type of arithmetic if expression");
        frexpr(expr);
    }
    else
    {
        if (lm == lz && lz == lp)
            exgoto (neglab);
        else if(lm == lz)
            exar2(OPLE, expr, neglab, poslab);
        else if(lm == lp)
            exar2(OPNE, expr, neglab, zerlab);
        else if(lz == lp)
            exar2(OPGE, expr, zerlab, neglab);
        else {
            expptr t;

            if (!addressable (expr)) {
                t = (expptr) mktmp(expr -> headblock.vtype, ENULL);
                expr = mkexpr (OPASSIGN, cpexpr (t), expr);
            } else
                t = (expptr) cpexpr (expr);

            p1_if(putx(fixtype(mkexpr (OPLT, expr, ICON (0)))));
            exgoto(neglab);
            p1_elif (mkexpr (OPEQ, t, ICON (0)));
            exgoto(zerlab);
            p1_else ();
            exgoto(poslab);
            p1else_end ();
        } /* else */
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exasgoto

(

Namep

labvar

)

Definition at line 973 of file exec.c.

References err, ISINT, mkplace(), p, and p1_asgoto().

Referenced by yyparse().

{
        register Addrp p;

        p = mkplace(labvar);
        if( ! ISINT(p->vtype) )
                err("assigned goto variable must be integer");
        else {
                p1_asgoto (p);
        } /* else */
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exassign	(	register Namep	vname,
		struct Labelblock *	labelval
	)

Definition at line 782 of file exec.c.

References ALLOC, CHNULL, Chain::datap, err, Labelblock::fmtlabused, fmtname(), Labelblock::fmtstring, ICON, Addrblock::ident, Labelblock::labdefined, Labelblock::labused, Addrblock::memoffset, mkchain(), mkexpr(), mkintcon(), mkplace(), MSKADDR, MSKINT, Chain::nextp, Addrblock::ntempelt, ONEOF, OPASSIGN, p, putout(), Labelblock::stateno, STGAUTO, stno, TADDR, Addrblock::tag, TYCHAR, UNAM_IDENT, Addrblock::uname_tag, Addrblock::user, Addrblock::vstg, and Addrblock::vtype.

Referenced by yyparse().

{
        Addrp p;
        register Addrp q;
        char *fs;
        register chainp cp, cpprev;
        register ftnint k, stno;

        p = mkplace(vname);
        if( ! ONEOF(p->vtype, MSKINT|MSKADDR) ) {
                err("noninteger assign variable");
                return;
                }

        /* If the label hasn't been defined, then we do things twice:
         * once for an executable stmt label, once for a format
         */

        /* code for executable label... */

/* Now store the assigned value in a list associated with this variable.
   This will be used later to generate a switch() statement in the C output */

        fs = labelval->fmtstring;
        if (!labelval->labdefined || !fs) {

                if (vname -> vis_assigned == 0) {
                        vname -> varxptr.assigned_values = CHNULL;
                        vname -> vis_assigned = 1;
                        }

                /* don't duplicate labels... */

                stno = labelval->stateno;
                cpprev = 0;
                for(k = 0, cp = vname->varxptr.assigned_values;
                                cp; cpprev = cp, cp = cp->nextp, k++)
                        if ((ftnint)cp->datap == stno)
                                break;
                if (!cp) {
                        cp = mkchain((char *)stno, CHNULL);
                        if (cpprev)
                                cpprev->nextp = cp;
                        else
                                vname->varxptr.assigned_values = cp;
                        labelval->labused = 1;
                        }
                putout(mkexpr(OPASSIGN, (expptr)p, mkintcon(k)));
                }

        /* Code for FORMAT label... */

        if (!labelval->labdefined || fs) {

                labelval->fmtlabused = 1;
                p = ALLOC(Addrblock);
                p->tag = TADDR;
                p->vtype = TYCHAR;
                p->vstg = STGAUTO;
                p->memoffset = ICON(0);
                fmtname(vname, p);
                q = ALLOC(Addrblock);
                q->tag = TADDR;
                q->vtype = TYCHAR;
                q->vstg = STGAUTO;
                q->ntempelt = 1;
                q->memoffset = ICON(0);
                q->uname_tag = UNAM_IDENT;
                sprintf(q->user.ident, "fmt_%ld", labelval->stateno);
                putout(mkexpr(OPASSIGN, (expptr)p, (expptr)q));
                }

} /* exassign */

Here is the call graph for this function:

Here is the caller graph for this function:

void excall	(	Namep	name,
		struct Listblock *	args,
		int	nstars,
		struct Labelblock **	labels
	)

Definition at line 362 of file exec.c.

References args, CHNULL, fixtype(), frexpr(), mixed_type(), mkfunct(), mkprim(), name, p, putcmgo(), putexpr(), putx(), settype(), TERROR, TYINT, TYSUBR, and TYUNKNOWN.

Referenced by yyparse().

{
        register expptr p;

        if (name->vtype != TYSUBR) {
                if (name->vinfproc && !name->vcalled) {
                        name->vtype = TYSUBR;
                        frexpr(name->vleng);
                        name->vleng = 0;
                        }
                else if (!name->vimpltype && name->vtype != TYUNKNOWN)
                        mixed_type(name);
                else
                        settype(name, TYSUBR, (ftnint)0);
                }
        p = mkfunct( mkprim(name, args, CHNULL) );
        if (p->tag == TERROR)
                return;

/* Subroutines and their identifiers acquire the type INT */

        p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT;

/* Handle the alternate return mechanism */

        if(nstars > 0)
                putcmgo(putx(fixtype(p)), nstars, labels);
        else
                putexpr(p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exdo	(	int	range,
		Namep	loopname,
		chainp	spec
	)

Definition at line 470 of file exec.c.

References conssgn(), cpexpr(), CTLDO, ctlstack, Chain::datap, dclerr(), DOINCR, DOINIT, Ctlframe::doinit, Ctlframe::dolabel, DOLIMIT, Ctlframe::domax, Ctlframe::donamep, dorange, Ctlframe::dostep, Ctlframe::dostepsign, Ctlframe::dowhile, ENULL, err, erri(), errstr(), fixtype(), frchain(), frexpr(), Nameblock::fvarname, i, ICON, init, ISCONST, Ctlframe::loopname, mkconv(), mkexpr(), mkplace(), mktmp(), mktmp0(), MSKINT, MSKREAL, NEGSTEP, Chain::nextp, NOEXT, NULL, ONEOF, onetripflag, OPASSIGN, OPCOLON, OPEQ, OPGE, OPLE, OPLT, OPMINUS, OPOR, OPPLUSEQ, OPQUEST, p, p1_for(), POSSTEP, pushctl(), puteq(), putwhile(), putx(), test, TYLABEL, TYUNKNOWN, VARSTEP, Nameblock::vclass, Nameblock::vdcldone, Nameblock::vdovar, Nameblock::vprocclass, Addrblock::vtype, Nameblock::vtype, warn(), and YES.

Referenced by doiolist(), and yyparse().

{
        register expptr p;
        register Namep np;
        chainp cp;              /* loops over the fields in   spec */
        register int i;
        int dotype;             /* type of the index variable */
        int incsign;            /* sign of the increment, if it's constant
                                   */
        Addrp dovarp;           /* loop index variable */
        expptr doinit;          /* constant or register for init param */
        expptr par[3];          /* local specification parameters */

        expptr init, test, inc; /* Expressions in the resulting FOR loop */


        test = ENULL;

        pushctl(CTLDO);
        dorange = ctlstack->dolabel = range;
        ctlstack->loopname = loopname;

/* Declare the loop index */

        np = (Namep)spec->datap;
        ctlstack->donamep = NULL;
        if (!np) { /* do while */
                ctlstack->dowhile = 1;
#if 0
                if (loopname) {
                        if (loopname->vtype == TYUNKNOWN) {
                                loopname->vdcldone = 1;
                                loopname->vclass = CLLABEL;
                                loopname->vprocclass = PLABEL;
                                loopname->vtype = TYLABEL;
                                }
                        if (loopname->vtype == TYLABEL)
                                if (loopname->vdovar)
                                        dclerr("already in use as a loop name",
                                                loopname);
                                else
                                        loopname->vdovar = 1;
                        else
                                dclerr("already declared; cannot be a loop name",
                                        loopname);
                        }
#endif
                putwhile((expptr)spec->nextp);
                NOEXT("do while");
                spec->nextp = 0;
                frchain(&spec);
                return;
                }
        if(np->vdovar)
        {
                errstr("nested loops with variable %s", np->fvarname);
                ctlstack->donamep = NULL;
                return;
        }

/* Create a memory-resident version of the index variable */

        dovarp = mkplace(np);
        if( ! ONEOF(dovarp->vtype, MSKINT|MSKREAL) )
        {
                err("bad type on do variable");
                return;
        }
        ctlstack->donamep = np;

        np->vdovar = YES;

/* Now   dovarp   points to the index to be used within the loop,   dostgp
   points to the one which may need to be stored */

        dotype = dovarp->vtype;

/* Count the input specifications and type-check each one independently;
   this just eliminates non-numeric values from the specification */

        for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp)
        {
                p = par[i++] = fixtype((tagptr)cp->datap);
                if( ! ONEOF(p->headblock.vtype, MSKINT|MSKREAL) )
                {
                        err("bad type on DO parameter");
                        return;
                }
        }

        frchain(&spec);
        switch(i)
        {
        case 0:
        case 1:
                err("too few DO parameters");
                return;

        default:
                err("too many DO parameters");
                return;

        case 2:
                DOINCR = (expptr) ICON(1);

        case 3:
                break;
        }


/* Now all of the local specification fields are set, but their types are
   not yet consistent */

/* Declare the loop initialization value, casting it properly and declaring a
   register if need be */

        ctlstack->doinit = 0;
        if (ISCONST (DOINIT) || !onetripflag)
/* putx added 6-29-89 (mwm), not sure if fixtype is required, but I doubt it
   since mkconv is called just before */
                doinit = putx (mkconv (dotype, DOINIT));
        else  {
            if (onetripflag)
                ctlstack->doinit = doinit = (expptr) mktmp0(dotype, ENULL);
            else
                doinit = (expptr) mktmp(dotype, ENULL);
            puteq (cpexpr (doinit), DOINIT);
        } /* else */

/* Declare the loop ending value, casting it to the type of the index
   variable */

        if( ISCONST(DOLIMIT) )
                ctlstack->domax = mkconv(dotype, DOLIMIT);
        else {
                ctlstack->domax = (expptr) mktmp0(dotype, ENULL);
                puteq (cpexpr (ctlstack -> domax), DOLIMIT);
        } /* else */

/* Declare the loop increment value, casting it to the type of the index
   variable */

        if( ISCONST(DOINCR) )
        {
                ctlstack->dostep = mkconv(dotype, DOINCR);
                if( (incsign = conssgn(ctlstack->dostep)) == 0)
                        err("zero DO increment");
                ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
        }
        else
        {
                ctlstack->dostep = (expptr) mktmp0(dotype, ENULL);
                ctlstack->dostepsign = VARSTEP;
                puteq (cpexpr (ctlstack -> dostep), DOINCR);
        }

/* All data is now properly typed and in the   ctlstack,   except for the
   initial value.  Assignments of temps have been generated already */

        switch (ctlstack -> dostepsign) {
            case VARSTEP:
                test = mkexpr (OPQUEST, mkexpr (OPLT,
                        cpexpr (ctlstack -> dostep), ICON(0)),
                        mkexpr (OPCOLON,
                            mkexpr (OPGE, cpexpr((expptr)dovarp),
                                    cpexpr (ctlstack -> domax)),
                            mkexpr (OPLE, cpexpr((expptr)dovarp),
                                    cpexpr (ctlstack -> domax))));
                break;
            case POSSTEP:
                test = mkexpr (OPLE, cpexpr((expptr)dovarp),
                        cpexpr (ctlstack -> domax));
                break;
            case NEGSTEP:
                test = mkexpr (OPGE, cpexpr((expptr)dovarp),
                        cpexpr (ctlstack -> domax));
                break;
            default:
                erri ("exdo:  bad dostepsign '%d'", ctlstack -> dostepsign);
                break;
        } /* switch (ctlstack -> dostepsign) */

        if (onetripflag)
            test = mkexpr (OPOR, test,
                    mkexpr (OPEQ, cpexpr((expptr)dovarp), cpexpr (doinit)));
        init = mkexpr (OPASSIGN, cpexpr((expptr)dovarp),
                        ctlstack->doinit ? cpexpr(doinit) : doinit);
        inc = mkexpr (OPPLUSEQ, (expptr)dovarp, cpexpr (ctlstack -> dostep));

        if (!onetripflag && ISCONST (ctlstack -> domax) && ISCONST (doinit)
                && ctlstack -> dostepsign != VARSTEP) {
            expptr tester;

            tester = mkexpr (OPMINUS, cpexpr (doinit),
                    cpexpr (ctlstack -> domax));
            if (incsign == conssgn (tester))
                warn ("DO range never executed");
            frexpr (tester);
        } /* if !onetripflag && */

        p1_for (init, test, inc);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exelif

(

expptr

p

)

Definition at line 53 of file exec.c.

References CNULL, CTLIF, CTLIFX, ctlstack, Ctlframe::ctltype, execerr(), p, and putif().

Referenced by yyparse().

{
    if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX)
        putif(p, 1);    /* 1 ==> elseif */
    else
        execerr("elseif out of place", CNULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exelse

(

Void

)

Definition at line 66 of file exec.c.

References CTLELSE, CTLIF, CTLIFX, ctlstack, Ctlframe::ctltype, and p1_else().

Referenced by yyparse().

{
        register struct Ctlframe *c;

        for(c = ctlstack; c->ctltype == CTLIFX; --c);
        if(c->ctltype == CTLIF) {
                p1_else ();
                c->ctltype = CTLELSE;
                }
        else
                execerr("else out of place", CNULL);
        }

Here is the call graph for this function:

Here is the caller graph for this function:

void exenddo

(

Namep

np

)

Definition at line 681 of file exec.c.

References CTLDO, ctls, ctlstack, Ctlframe::ctltype, Ctlframe::dolabel, err, errstr(), Nameblock::fvarname, Labelblock::labelno, Ctlframe::loopname, and thislabel.

Referenced by yyparse().

{
        Namep np1;
        int here;
        struct Ctlframe *cf;

        if( ctlstack < ctls )
                goto misplaced;
        here = ctlstack->dolabel;
        if (ctlstack->ctltype != CTLDO
        || here >= 0 && (!thislabel || thislabel->labelno != here)) {
 misplaced:
                err("misplaced ENDDO");
                return;
                }
        if (np != ctlstack->loopname) {
                if (np1 = ctlstack->loopname)
                        errstr("expected \"enddo %s\"", np1->fvarname);
                else
                        err("expected unnamed ENDDO");
                for(cf = ctls; cf < ctlstack; cf++)
                        if (cf->ctltype == CTLDO && cf->loopname == np) {
                                here = cf->dolabel;
                                break;
                                }
                }
        enddo(here);
        }

Here is the call graph for this function:

Here is the caller graph for this function:

void exendif

(

)

Definition at line 83 of file exec.c.

References CNULL, CTLELSE, CTLIF, CTLIFX, ctlstack, Ctlframe::ctltype, execerr(), p1_endif(), p1else_end(), and popctl().

{
        while(ctlstack->ctltype == CTLIFX) {
                popctl();
                p1else_end();
                }
        if(ctlstack->ctltype == CTLIF) {
                popctl();
                p1_endif ();
                }
        else if(ctlstack->ctltype == CTLELSE) {
                popctl();
                p1else_end ();
                }
        else
                execerr("endif out of place", CNULL);
        }

Here is the call graph for this function:

void exequals	(	register struct Primblock *	lp,
		register expptr	rp
	)

Definition at line 244 of file exec.c.

References cktype1(), CLVAR, enddcl(), err, errstr(), fixtype(), frexpr(), INDATA, INEXEC, keepsubs, mklhs(), mkstfunct(), parstate, puteq(), TPRIM, and TYSUBR.

Referenced by yyparse().

{
        if(lp->tag != TPRIM)
        {
                err("assignment to a non-variable");
                frexpr((expptr)lp);
                frexpr(rp);
        }
        else if(lp->namep->vclass!=CLVAR && lp->argsp)
        {
                if(parstate >= INEXEC)
                        errstr("statement function %.62s amid executables.",
                                lp->namep->fvarname);
                mkstfunct(lp, rp);
        }
        else if (lp->vtype == TYSUBR)
                err("illegal use of subroutine name");
        else
        {
                expptr new_lp, new_rp;

                if(parstate < INDATA) {
                        enddcl();
                        lp = (struct Primblock *)cktype1((expptr)lp);
                        rp = cktype1(rp);
                        }
                new_lp = mklhs (lp, keepsubs);
                new_rp = fixtype (rp);
                puteq(new_lp, new_rp);
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exgoto

(

struct Labelblock *

lab

)

Definition at line 179 of file exec.c.

References Labelblock::labused, p1_goto(), and Labelblock::stateno.

Referenced by endio(), exar2(), exarif(), putiocall(), and yyparse().

{
        lab->labused = 1;
        p1_goto (lab -> stateno);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exif

(

expptr

p

)

Definition at line 40 of file exec.c.

References CTLIF, p, pushctl(), and putif().

Referenced by endio(), putiocall(), and yyparse().

{
    pushctl(CTLIF);
    putif(p, 0);        /* 0 => if, not elseif */
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exreturn

(

register expptr

p

)

Definition at line 947 of file exec.c.

References CLPROC, ENULL, err, fixtype(), ICON, mkconv(), p1_subr_ret(), procclass, proctype, retslot, TYLONG, TYSUBR, and warn().

Referenced by yyparse().

{
        if(procclass != CLPROC)
                warn("RETURN statement in main or block data");
        if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
        {
                err("alternate return in nonsubroutine");
                p = 0;
        }

        if (p || proctype == TYSUBR) {
                if (p == ENULL) p = ICON (0);
                p = mkconv (TYLONG, fixtype (p));
                p1_subr_ret (p);
        } /* if p || proctype == TYSUBR */
        else
            p1_subr_ret((expptr)retslot);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void exstop	(	int	stop,
		register expptr	p
	)

Definition at line 401 of file exec.c.

References call1(), CNULL, convic(), copyn(), execerr(), frexpr(), ICON, ISCONST, ISINT, mkstrcon(), n, putexpr(), str, TYCHAR, and TYSUBR.

Referenced by yyparse().

{
        char *str;
        int n;

        if(p)
        {
                if( ! ISCONST(p) )
                {
                        execerr("pause/stop argument must be constant", CNULL);
                        frexpr(p);
                        p = mkstrcon(0, CNULL);
                }
                else if( ISINT(p->constblock.vtype) )
                {
                        str = convic(p->constblock.Const.ci);
                        n = strlen(str);
                        if(n > 0)
                        {
                                p->constblock.Const.ccp = copyn(n, str);
                                p->constblock.Const.ccp1.blanks = 0;
                                p->constblock.vtype = TYCHAR;
                                p->constblock.vleng = (expptr) ICON(n);
                        }
                        else
                                p = (expptr) mkstrcon(0, CNULL);
                }
                else if(p->constblock.vtype != TYCHAR)
                {
                        execerr("pause/stop argument must be integer or string", CNULL);
                        p = (expptr) mkstrcon(0, CNULL);
                }
        }
        else    p = (expptr) mkstrcon(0, CNULL);

    {
        expptr subr_call;

        subr_call = call1(TYSUBR, (char*)(stop ? "s_stop" : "s_paus"), p);
        putexpr( subr_call );
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void mixed_type

(

Namep

np

)

[static]

Definition at line 345 of file exec.c.

References buf, ftn_types, Nameblock::fvarname, Nameblock::vtype, and warn().

Referenced by excall().

{
        char buf[128];
        sprintf(buf, "%s function %.90s invoked as subroutine",
                ftn_types[np->vtype], np->fvarname);
        warn(buf);
        }

Here is the call graph for this function:

Here is the caller graph for this function:

void mkstfunct	(	struct Primblock *	lp,
		expptr	rp
	)

Definition at line 290 of file exec.c.

References args, CHNULL, CLPROC, CLUNKNOWN, dclerr(), err, impldcl(), lp, mkchain(), p, PSTFUNCT, STGSTFUNCT, thisstno, TPRIM, TYCHAR, Nameblock::varxptr, Nameblock::vclass, Nameblock::vleng, Nameblock::vprocclass, Nameblock::vstfdesc, Nameblock::vstg, and Nameblock::vtype.

Referenced by exequals().

{
        register struct Primblock *p;
        register Namep np;
        chainp args;

        laststfcn = thisstno;
        np = lp->namep;
        if(np->vclass == CLUNKNOWN)
                np->vclass = CLPROC;
        else
        {
                dclerr("redeclaration of statement function", np);
                return;
        }
        np->vprocclass = PSTFUNCT;
        np->vstg = STGSTFUNCT;

/* Set the type of the function */

        impldcl(np);
        if (np->vtype == TYCHAR && !np->vleng)
                err("character statement function with length (*)");
        args = (lp->argsp ? lp->argsp->listp : CHNULL);
        np->varxptr.vstfdesc = mkchain((char *)args, (chainp)rp);

        for(doing_stmtfcn = 1 ; args ; args = args->nextp)

/* It is an error for the formal parameters to have arguments or
   subscripts */

                if( ((tagptr)(args->datap))->tag!=TPRIM ||
                    (p = (struct Primblock *)(args->datap) )->argsp ||
                    p->fcharp || p->lcharp ) {
                        err("non-variable argument in statement function definition");
                        args->datap = 0;
                        }
                else
                {

/* Replace the name on the left-hand side */

                        args->datap = (char *)p->namep;
                        vardcl(p -> namep);
                        free((char *)p);
                }
        doing_stmtfcn = 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void new_endif

(

)

Definition at line 107 of file exec.c.

References CTLIF, CTLIFX, ctlstack, Ctlframe::ctltype, err, and pushctl().

{
        if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX)
                pushctl(CTLIFX);
        else
                err("new_endif bug");
        }

Here is the call graph for this function:

LOCAL void popctl

(

Void

)

Definition at line 141 of file exec.c.

References blklevel, ctls, ctlstack, and Fatal().

Referenced by enddo(), and exendif().

{
        if( ctlstack-- < ctls )
                Fatal("control stack empty");
        --blklevel;
}

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void poplab

(

Void

)

Definition at line 153 of file exec.c.

References blklevel, highlabtab, labeltab, lp, and YES.

Referenced by enddo().

{
        register struct Labelblock  *lp;

        for(lp = labeltab ; lp < highlabtab ; ++lp)
                if(lp->labdefined)
                {
                        /* mark all labels in inner blocks unreachable */
                        if(lp->blklevel > (unsigned int)(blklevel))
                                lp->labinacc = YES;
                }
                else if(lp->blklevel > (unsigned int)(blklevel))
                {
                        /* move all labels referred to in inner blocks out a level */
                        lp->blklevel = blklevel;
                }
}

Here is the caller graph for this function:

LOCAL void pushctl

(

int

code

)

Definition at line 124 of file exec.c.

References blklevel, Ctlframe::ctlabels, ctlstack, Ctlframe::ctltype, Ctlframe::domax, Ctlframe::dostep, Ctlframe::dowhile, i, lastctl, many(), and maxctl.

Referenced by exdo(), exif(), and new_endif().

{
        register int i;

        if(++ctlstack >= lastctl)
                many("loops or if-then-elses", 'c', maxctl);
        ctlstack->ctltype = code;
        for(i = 0 ; i < 4 ; ++i)
                ctlstack->ctlabels[i] = 0;
        ctlstack->dowhile = 0;
        ctlstack->domax = ctlstack->dostep = 0; /* in case of errors */
        ++blklevel;
}

Here is the call graph for this function:

Here is the caller graph for this function:

---

Variable Documentation

int doing_stmtfcn

Definition at line 282 of file exec.c.

Referenced by vardcl().

long laststfcn = -1

Definition at line 281 of file exec.c.

Referenced by yyparse().

long thisstno

Definition at line 281 of file exec.c.

Referenced by mkstfunct(), and yyparse().

---