/* takes the address of a node, possibly converting it to * a pointer to the base type 'bt' */ static Node *addr(Simp *s, Node *a, Type *bt) { Node *n; n = mkexpr(a->line, Oaddr, a, NULL); if (!addressable(s, a)) declarelocal(s, a); if (!bt) n->expr.type = mktyptr(a->line, a->expr.type); else n->expr.type = mktyptr(a->line, bt); return n; }
addressable(expptr p) #endif { if (p) switch(p->tag) { case TCONST: return(YES); case TADDR: return( addressable(p->addrblock.memoffset) ); } return(NO); }
addressable(register expptr p) #endif { switch(p->tag) { case TCONST: return(YES); case TADDR: return( addressable(p->addrblock.memoffset) ); default: return(NO); } }
Inline(int fno, int type, struct Chain *args) #endif { register expptr q, t, t1; switch(fno) { case 8: /* real abs */ case 9: /* short int abs */ case 10: /* long int abs */ case 11: /* double precision abs */ if( addressable(q = (expptr) args->datap) ) { t = q; q = NULL; } else t = (expptr) mktmp(type,ENULL); t1 = mkexpr(type == TYREAL && forcedouble ? OPDABS : OPABS, cpexpr(t), ENULL); if(q) t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1); frexpr(t); return(t1); case 26: /* dprod */ q = mkexpr(OPSTAR, mkconv(TYDREAL,(expptr)args->datap), (expptr)args->nextp->datap); return(q); case 27: /* len of character string */ q = (expptr) cpexpr(((tagptr)args->datap)->headblock.vleng); frexpr((expptr)args->datap); return(q); case 14: /* half-integer mod */ case 15: /* mod */ return mkexpr(OPMOD, (expptr) args->datap, (expptr) args->nextp->datap); } return(NULL); }
LOCAL struct bigblock * putcx1(bigptr qq) { struct bigblock *q, *lp, *rp; register struct bigblock *resp; NODE *p; int opcode; int ltype, rtype; ltype = rtype = 0; /* XXX gcc */ if(qq == NULL) return(NULL); switch(qq->tag) { case TCONST: if( ISCOMPLEX(qq->vtype) ) qq = putconst(qq); return( qq ); case TADDR: if( ! addressable(qq) ) { resp = fmktemp(tyint, NULL); p = putassign( cpexpr(resp), qq->b_addr.memoffset ); sendp2(p); qq->b_addr.memoffset = resp; } return( qq ); case TEXPR: if( ISCOMPLEX(qq->vtype) ) break; resp = fmktemp(TYDREAL, NO); p = putassign( cpexpr(resp), qq); sendp2(p); return(resp); default: fatal1("putcx1: bad tag %d", qq->tag); } opcode = qq->b_expr.opcode; if(opcode==OPCALL || opcode==OPCCALL) { q = putcall(qq); sendp2(callval); return(q); } else if(opcode == OPASSIGN) { return( putcxeq(qq) ); } resp = fmktemp(qq->vtype, NULL); if((lp = putcx1(qq->b_expr.leftp) )) ltype = lp->vtype; if((rp = putcx1(qq->b_expr.rightp) )) rtype = rp->vtype; switch(opcode) { case OPCOMMA: frexpr(resp); resp = rp; rp = NULL; break; case OPNEG: p = putassign(realpart(resp), mkexpr(OPNEG, realpart(lp), NULL)); sendp2(p); p = putassign(imagpart(resp), mkexpr(OPNEG, imagpart(lp), NULL)); sendp2(p); break; case OPPLUS: case OPMINUS: p = putassign( realpart(resp), mkexpr(opcode, realpart(lp), realpart(rp) )); sendp2(p); if(rtype < TYCOMPLEX) { p = putassign(imagpart(resp), imagpart(lp) ); } else if(ltype < TYCOMPLEX) { if(opcode == OPPLUS) p = putassign( imagpart(resp), imagpart(rp) ); else p = putassign( imagpart(resp), mkexpr(OPNEG, imagpart(rp), NULL) ); } else p = putassign( imagpart(resp), mkexpr(opcode, imagpart(lp), imagpart(rp) )); sendp2(p); break; case OPSTAR: if(ltype < TYCOMPLEX) { if( ISINT(ltype) ) lp = intdouble(lp); p = putassign( realpart(resp), mkexpr(OPSTAR, cpexpr(lp), realpart(rp) )); sendp2(p); p = putassign( imagpart(resp), mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) )); } else if(rtype < TYCOMPLEX) { if( ISINT(rtype) ) rp = intdouble(rp); p = putassign( realpart(resp), mkexpr(OPSTAR, cpexpr(rp), realpart(lp) )); sendp2(p); p = putassign( imagpart(resp), mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) )); } else { p = putassign( realpart(resp), mkexpr(OPMINUS, mkexpr(OPSTAR, realpart(lp), realpart(rp)), mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) )); sendp2(p); p = putassign( imagpart(resp), mkexpr(OPPLUS, mkexpr(OPSTAR, realpart(lp), imagpart(rp)), mkexpr(OPSTAR, imagpart(lp), realpart(rp)) )); } sendp2(p); break; case OPSLASH: /* fixexpr has already replaced all divisions * by a complex by a function call */ if( ISINT(rtype) ) rp = intdouble(rp); p = putassign( realpart(resp), mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) ); sendp2(p); p = putassign( imagpart(resp), mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) ); sendp2(p); break; case OPCONV: p = putassign( realpart(resp), realpart(lp) ); if( ISCOMPLEX(lp->vtype) ) q = imagpart(lp); else if(rp != NULL) q = realpart(rp); else q = mkrealcon(TYDREAL, 0.0); sendp2(p); p = putassign( imagpart(resp), q); sendp2(p); break; default: fatal1("putcx1 of invalid opcode %d", opcode); } frexpr(lp); frexpr(rp); ckfree(qq); return(resp); }