1: #include "defs"
   2: 
   3: ptr gentemp(t)
   4: ptr t;
   5: {
   6: register ptr oldp;
   7: register ptr p;
   8: register ptr q;
   9: int ttype;
  10: ptr ttypep, tdim;
  11: 
  12: /* search the temporary list for a matching type */
  13: 
  14: ttype = t->vtype;
  15: ttypep = t->vtypep;
  16: tdim = t->vdim;
  17: 
  18: for(oldp = &tempvarlist ; p = oldp->nextp ; oldp = p)
  19:     if( (q = p->datap) && (q->vtype == ttype) &&
  20:       (q->vtypep == ttypep) && eqdim(q->vdim,tdim) )
  21:         {
  22:         oldp->nextp = p->nextp;
  23:         break;
  24:         }
  25: 
  26: if(p == PNULL)
  27:     {
  28:     q = allexpblock();
  29:     q->tag = TTEMP;
  30:     q->subtype = t->subtype;
  31:     q->vtype = ttype;
  32:     q->vclass = t->vclass;
  33:     q->vtypep = ( ttypep ? cpexpr(ttypep) : PNULL);
  34:     q->vdim = tdim;
  35:     mkftnp(q);  /* assign fortran types */
  36: 
  37:     p = mkchain(q, CHNULL);
  38:     p->datap = q;
  39:     }
  40: 
  41: p->nextp = thisexec->temps;
  42: thisexec->temps = p;
  43: 
  44: return( cpexpr(q) );
  45: /* need a copy of the block for the temporary list and another for use */
  46: }
  47: 
  48: 
  49: ptr gent(t,tp)  /* make a temporary of type t, typepointer tp */
  50: int t;
  51: ptr tp;
  52: {
  53: static struct varblock model;
  54: 
  55: model.vtype = t;
  56: model.vtypep = tp;
  57: 
  58: return( gentemp(&model) );
  59: }

Defined functions

gentemp defined in line 3; used 7 times
Last modified: 1982-06-09
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 693
Valid CSS Valid XHTML 1.0 Strict