| 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 | } |