/* * Move args to registers and emit expressions bottom-up. */ static void fixargs(NODE *p) { NODE *r; if (p->n_op == CM) { fixargs(p->n_left); r = p->n_right; if (r->n_op == STARG) regnum = 9; /* end of register list */ else if (regnum + szty(r->n_type) > 8) p->n_right = block(FUNARG, r, NIL, r->n_type, r->n_df, r->n_sue); else p->n_right = buildtree(ASSIGN, mkreg(r, regnum), r); } else { if (p->n_op == STARG) { regnum = 9; /* end of register list */ } else { r = talloc(); *r = *p; r = buildtree(ASSIGN, mkreg(r, regnum), r); *p = *r; nfree(r); } r = p; } regnum += szty(r->n_type); }
/* * Called with a function call with arguments as argument. * This is done early in buildtree() and only done once. */ NODE * funcode(NODE *p) { regnum = 1; fixargs(p->n_right); return p; }
intrcall(Namep np, struct Listblock *argsp, int nargs) #endif { int i, rettype; Addrp ap; register struct Specblock *sp; register struct Chain *cp; expptr q, ep; int mtype; int op; int f1field, f2field, f3field; packed.ijunk = np->vardesc.varno; f1field = packed.bits.f1; f2field = packed.bits.f2; f3field = packed.bits.f3; if(nargs == 0) goto badnargs; mtype = 0; for(cp = argsp->listp ; cp ; cp = cp->nextp) { ep = (expptr)cp->datap; if( ISCONST(ep) && ep->headblock.vtype==TYSHORT ) cp->datap = (char *) mkconv(tyint, ep); mtype = maxtype(mtype, ep->headblock.vtype); } switch(f1field) { case INTRBOOL: op = f3field; if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) ) goto badtype; if(op == OPBITNOT) { if(nargs != 1) goto badnargs; q = mkexpr(OPBITNOT, (expptr)argsp->listp->datap, ENULL); } else { if(nargs != 2) goto badnargs; q = mkexpr(op, (expptr)argsp->listp->datap, (expptr)argsp->listp->nextp->datap); } frchain( &(argsp->listp) ); free( (charptr) argsp); return(q); case INTRCONV: rettype = f2field; switch(rettype) { case TYLONG: rettype = tyint; break; case TYLOGICAL: rettype = tylog; } if( ISCOMPLEX(rettype) && nargs==2) { expptr qr, qi; qr = (expptr) argsp->listp->datap; qi = (expptr) argsp->listp->nextp->datap; if(ISCONST(qr) && ISCONST(qi)) q = mkcxcon(qr,qi); else q = mkexpr(OPCONV,mkconv(rettype-2,qr), mkconv(rettype-2,qi)); } else if(nargs == 1) { if (f3field && ((Exprp)argsp->listp->datap)->vtype == TYDCOMPLEX) rettype = TYDREAL; q = mkconv(rettype+100, (expptr)argsp->listp->datap); if (q->tag == TADDR) q->addrblock.parenused = 1; } else goto badnargs; q->headblock.vtype = rettype; frchain(&(argsp->listp)); free( (charptr) argsp); return(q); #if 0 case INTRCNST: /* Machine-dependent f77 stuff that f2c omits: intcon contains radix for short int radix for long int radix for single precision radix for double precision precision for short int precision for long int precision for single precision precision for double precision emin for single precision emin for double precision emax for single precision emax for double prcision largest short int largest long int realcon contains tiny for single precision tiny for double precision huge for single precision huge for double precision mrsp (epsilon) for single precision mrsp (epsilon) for double precision */ { register struct Incstblock *cstp; extern ftnint intcon[14]; extern double realcon[6]; cstp = consttab + f3field; for(i=0 ; i<f2field ; ++i) if(cstp->atype == mtype) goto foundconst; else ++cstp; goto badtype; foundconst: switch(cstp->rtype) { case TYLONG: return(mkintcon(intcon[cstp->constno])); case TYREAL: case TYDREAL: return(mkrealcon(cstp->rtype, realcon[cstp->constno]) ); default: Fatal("impossible intrinsic constant"); } } #endif case INTRGEN: sp = spectab + f3field; if(no66flag) if(sp->atype == mtype) goto specfunct; else err66("generic function"); for(i=0; i<f2field ; ++i) if(sp->atype == mtype) goto specfunct; else ++sp; warn1 ("bad argument type to intrinsic %s", np->fvarname); /* Made this a warning rather than an error so things like "log (5) ==> log (5.0)" can be accommodated. When none of these cases matches, the argument is cast up to the first type in the spectab list; this first type is assumed to be the "smallest" type, e.g. REAL before DREAL before COMPLEX, before DCOMPLEX */ sp = spectab + f3field; mtype = sp -> atype; goto specfunct; case INTRSPEC: sp = spectab + f3field; specfunct: if(tyint==TYLONG && ONEOF(sp->rtype,M(TYSHORT)|M(TYLOGICAL)) && (sp+1)->atype==sp->atype) ++sp; if(nargs != sp->nargs) goto badnargs; if(mtype != sp->atype) goto badtype; /* NOTE!! I moved fixargs (YES) into the ELSE branch so that constants in the inline expression wouldn't get put into the constant table */ fixargs (NO, argsp); cast_args (mtype, argsp -> listp); if(q = Inline((int)(sp-spectab), mtype, argsp->listp)) { frchain( &(argsp->listp) ); free( (charptr) argsp); } else { if(sp->othername) { /* C library routines that return double... */ /* sp->rtype might be TYREAL */ ap = builtin(sp->rtype, callbyvalue[sp->othername], 1); q = fixexpr((Exprp) mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) ); } else { fixargs(YES, argsp); ap = builtin(sp->rtype, sp->spxname, 0); q = fixexpr((Exprp) mkexpr(OPCALL, (expptr)ap, (expptr)argsp) ); } /* else */ } /* else */ return(q); case INTRMIN: case INTRMAX: if(nargs < 2) goto badnargs; if( ! ONEOF(mtype, MSKINT|MSKREAL) ) goto badtype; argsp->vtype = mtype; q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), (expptr)argsp, ENULL); q->headblock.vtype = mtype; rettype = f2field; if(rettype == TYLONG) rettype = tyint; else if(rettype == TYUNKNOWN) rettype = mtype; return( mkconv(rettype, q) ); default: fatali("intrcall: bad intrgroup %d", f1field); } badnargs: errstr("bad number of arguments to intrinsic %s", np->fvarname); goto bad; badtype: errstr("bad argument type to intrinsic %s", np->fvarname); bad: return( errnode() ); }
int sh_main(int ac, char *av[], Shinit_f userinit) { register char *name; register int fdin; register Sfio_t *iop; register Shell_t *shp; struct stat statb; int i, rshflag; /* set for restricted shell */ char *command; free(malloc(64*1024)); #ifdef _lib_sigvec /* This is to clear mask that may be left on by rlogin */ clearsigmask(SIGALRM); clearsigmask(SIGHUP); clearsigmask(SIGCHLD); #endif /* _lib_sigvec */ #ifdef _hdr_nc _NutConf(_NC_SET_SUFFIXED_SEARCHING, 1); #endif /* _hdr_nc */ fixargs(av,0); shp = sh_init(ac,av,userinit); time(&mailtime); if(rshflag=sh_isoption(SH_RESTRICTED)) sh_offoption(SH_RESTRICTED); if(sigsetjmp(*((sigjmp_buf*)shp->jmpbuffer),0)) { /* begin script execution here */ sh_reinit((char**)0); shp->gd->pid = getpid(); shp->gd->ppid = getppid(); } shp->fn_depth = shp->dot_depth = 0; command = error_info.id; /* set pidname '$$' */ srand(shp->gd->pid&0x7fff); if(nv_isnull(PS4NOD)) nv_putval(PS4NOD,e_traceprompt,NV_RDONLY); path_pwd(shp,1); iop = (Sfio_t*)0; #if SHOPT_BRACEPAT sh_onoption(SH_BRACEEXPAND); #endif if((beenhere++)==0) { sh_onstate(SH_PROFILE); ((Lex_t*)shp->lex_context)->nonstandard = 0; if(shp->gd->ppid==1) shp->login_sh++; if(shp->login_sh >= 2) sh_onoption(SH_LOGIN_SHELL); /* decide whether shell is interactive */ if(!sh_isoption(SH_INTERACTIVE) && !sh_isoption(SH_TFLAG) && !sh_isoption(SH_CFLAG) && sh_isoption(SH_SFLAG) && tty_check(0) && tty_check(ERRIO)) sh_onoption(SH_INTERACTIVE); if(sh_isoption(SH_INTERACTIVE)) { sh_onoption(SH_BGNICE); sh_onoption(SH_RC); } if(!sh_isoption(SH_RC) && (sh_isoption(SH_BASH) && !sh_isoption(SH_POSIX) #if SHOPT_REMOTE || !fstat(0, &statb) && REMOTE(statb.st_mode) #endif )) sh_onoption(SH_RC); for(i=0; i<elementsof(shp->offoptions.v); i++) shp->options.v[i] &= ~shp->offoptions.v[i]; if(sh_isoption(SH_INTERACTIVE)) { #ifdef SIGXCPU signal(SIGXCPU,SIG_DFL); #endif /* SIGXCPU */ #ifdef SIGXFSZ signal(SIGXFSZ,SIG_DFL); #endif /* SIGXFSZ */ sh_onoption(SH_MONITOR); } job_init(shp,sh_isoption(SH_LOGIN_SHELL)); if(sh_isoption(SH_LOGIN_SHELL)) { /* system profile */ sh_source(shp, iop, e_sysprofile); if(!sh_isoption(SH_NOUSRPROFILE) && !sh_isoption(SH_PRIVILEGED)) { char **files = shp->gd->login_files; while ((name = *files++) && !sh_source(shp, iop, sh_mactry(shp,name))); } } /* make sure PWD is set up correctly */ path_pwd(shp,1); if(!sh_isoption(SH_NOEXEC)) { if(!sh_isoption(SH_NOUSRPROFILE) && !sh_isoption(SH_PRIVILEGED) && sh_isoption(SH_RC)) { #if SHOPT_BASH if(sh_isoption(SH_BASH) && !sh_isoption(SH_POSIX)) { #if SHOPT_SYSRC sh_source(shp, iop, e_bash_sysrc); #endif sh_source(shp, iop, shp->gd->rcfile ? shp->gd->rcfile : sh_mactry(shp,(char*)e_bash_rc)); } else #endif { if(name = sh_mactry(shp,nv_getval(ENVNOD))) name = *name ? strdup(name) : (char*)0; #if SHOPT_SYSRC if(!strmatch(name, "?(.)/./*")) sh_source(shp, iop, e_sysrc); #endif if(name) { sh_source(shp, iop, name); free(name); } } } else if(sh_isoption(SH_INTERACTIVE) && sh_isoption(SH_PRIVILEGED)) sh_source(shp, iop, e_suidprofile); } shp->st.cmdname = error_info.id = command; sh_offstate(SH_PROFILE); if(rshflag) sh_onoption(SH_RESTRICTED); /* open input file if specified */ if(shp->comdiv) { shell_c: iop = sfnew(NIL(Sfio_t*),shp->comdiv,strlen(shp->comdiv),0,SF_STRING|SF_READ); }