BSD 3 development

[unix-history] / usr / src / cmd / pi / var.c

/* Copyright (c) 1979 Regents of the University of California */
#
/*
* pi - Pascal interpreter code translator
*
* Charles Haley, Bill Joy UCB
* Version 1.2 November 1978
*/

#include "whoami"
#include "0.h"

/*
* Declare variables of a var part.  DPOFF1 is
* the local variable storage for all prog/proc/func
* modules aside from the block mark.  The total size
* of all the local variables is entered into the
* size array.
*/
varbeg()
{

#ifndef PI1
       if (parts & VPRT)
               error("All variables must be declared in one var part");
       parts |= VPRT;
#endif
#ifndef PI0
       sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1;
#endif
       forechain = NIL;
#ifdef PI0
       send(REVVBEG);
#endif
}

var(vline, vidl, vtype)
#ifdef PI0
       int vline, *vidl, *vtype;
{
       register struct nl *np;
       register int *vl;

       np = gtype(vtype);
       line = vline;
       for (vl = vidl; vl != NIL; vl = vl[2])
               enter(defnl(vl[1], VAR, np, 0));
       send(REVVAR, vline, vidl, vtype);
}
#else
       int vline;
       register int *vidl;
       int *vtype;
{
       register struct nl *np;
       register struct om *op;
       long w;
       int o2;
       int *ovidl = vidl;

       np = gtype(vtype);
       line = vline;
       w = (lwidth(np) + 1) &~ 1;
       op = &sizes[cbn];
       for (; vidl != NIL; vidl = vidl[2]) {
               op->om_off -= w;
               o2 = op->om_off;
               enter(defnl(vidl[1], VAR, np, o2));
       }
#       ifdef PTREE
           {
               pPointer        *Vars;
               pPointer        Var = VarDecl( ovidl , vtype );

               pSeize( PorFHeader[ nesting ] );
               Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
               *Vars = ListAppend( *Vars , Var );
               pRelease( PorFHeader[ nesting ] );
           }
#       endif
}
#endif

varend()
{

       foredecl();
#ifndef PI0
       sizes[cbn].om_max = sizes[cbn].om_off;
#else
       send(REVVEND);
#endif
}

/*
* Evening
*/
even(w)
       register int w;
{
       if (w < 0)
               return (w & ~1);
       return ((w+1) & ~1);
}

/*
* Find the width of a type in bytes.
*/
width(np)
       struct nl *np;
{

       return (lwidth(np));
}

long lwidth(np)
       struct nl *np;
{
       register struct nl *p;
       long w;

       p = np;
       if (p == NIL)
               return (0);
loop:
       switch (p->class) {
               case TYPE:
                       switch (nloff(p)) {
                               case TNIL:
                                       return (2);
                               case TSTR:
                               case TSET:
                                       panic("width");
                               default:
                                       p = p->type;
                                       goto loop;
                       }
               case ARRAY:
                       return (aryconst(p, 0));
               case PTR:
               case FILET:
                       return ( sizeof ( int * ) );
               case RANGE:
                       if (p->type == nl+TDOUBLE)
#ifdef DEBUG
                               return (hp21mx ? 4 : 8);
#else
                               return (8);
#endif
               case SCAL:
                       return (bytes(p->range[0], p->range[1]));
               case SET:
                       setran(p->type);
                       return ( (set.uprbp>>3) + 1);
               case STR:
               case RECORD:
                       return ( p->value[NL_OFFS] );
               default:
                       panic("wclass");
       }
}

/*
* Return the width of an element
* of a n time subscripted np.
*/
long aryconst(np, n)
       struct nl *np;
       int n;
{
       register struct nl *p;
       long s, d;

       if ((p = np) == NIL)
               return (NIL);
       if (p->class != ARRAY)
               panic("ary");
       s = width(p->type);
       /*
        * Arrays of anything but characters are word aligned.
        */
       if (s & 1)
               if (s != 1)
                       s++;
       /*
        * Skip the first n subscripts
        */
       while (n >= 0) {
               p = p->chain;
               n--;
       }
       /*
        * Sum across remaining subscripts.
        */
       while (p != NIL) {
               if (p->class != RANGE && p->class != SCAL)
                       panic("aryran");
               d = p->range[1] - p->range[0] + 1;
               s *= d;
               p = p->chain;
       }
       return (s);
}

/*
* Find the lower bound of a set, and also its size in bits.
*/
setran(q)
       struct nl *q;
{
       register lb, ub;
       register struct nl *p;

       p = q;
       if (p == NIL)
               return (NIL);
       lb = p->range[0];
       ub = p->range[1];
       if (p->class != RANGE && p->class != SCAL)
               panic("setran");
       set.lwrb = lb;
       /* set.(upperbound prime) = number of bits - 1; */
       set.uprbp = ub-lb;
}

/*
* Return the number of bytes required to hold an arithmetic quantity
*/
bytes(lb, ub)
       long lb, ub;
{

#ifndef DEBUG
       if (lb < -32768 || ub > 32767)
               return (4);
       else if (lb < -128 || ub > 127)
               return (2);
#else
       if (!hp21mx && (lb < -32768 || ub > 32767))
               return (4);
       if (lb < -128 || ub > 127)
               return (2);
#endif
       else
               return (1);
}