realpart(register Addrp p)
#endif
{
register Addrp q;
if (p->tag == TADDR
&& p->uname_tag == UNAM_CONST
&& ISCOMPLEX (p->vtype))
return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
p->user.kludge.vstg1 ? p->user.Const.cds[0]
: cds(dtos(p->user.Const.cd[0]),CNULL));
q = (Addrp) cpexpr((expptr) p);
if( ISCOMPLEX(p->vtype) )
q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
return(q);
}
LOCAL struct bigblock *
putcxeq(struct bigblock *q)
{
struct bigblock *lp, *rp;
lp = putcx1(q->b_expr.leftp);
rp = putcx1(q->b_expr.rightp);
sendp2(putassign(realpart(lp), realpart(rp)));
if( ISCOMPLEX(q->vtype) ) {
sendp2(putassign(imagpart(lp), imagpart(rp)));
}
frexpr(rp);
ckfree(q);
return(lp);
}
imagpart(register Addrp p)
#endif
{
register Addrp q;
if( ISCOMPLEX(p->vtype) )
{
if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
p->user.kludge.vstg1 ? p->user.Const.cds[1]
: cds(dtos(p->user.Const.cd[1]),CNULL));
q = (Addrp) cpexpr((expptr) p);
q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
return( (expptr) q );
}
else
/* Cast an integer type onto a Double Real type */
return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
}
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);
}
/*
* Convert a f77 tree statement to something that looks like a
* pcc expression tree.
*/
NODE *
putx(bigptr q)
{
struct bigblock *x1;
NODE *p = NULL; /* XXX */
int opc;
int type, k;
#ifdef PCC_DEBUG
if (tflag) {
printf("putx %p\n", q);
fprint(q, 0);
}
#endif
switch(q->tag) {
case TERROR:
ckfree(q);
break;
case TCONST:
switch(type = q->vtype) {
case TYLOGICAL:
type = tyint;
case TYLONG:
case TYSHORT:
p = mklnode(ICON, q->b_const.fconst.ci,
0, types2[type]);
ckfree(q);
break;
case TYADDR:
p = mklnode(ICON, 0, 0, types2[type]);
p->n_name = copys(memname(STGCONST,
(int)q->b_const.fconst.ci));
ckfree(q);
break;
default:
p = putx(putconst(q));
break;
}
break;
case TEXPR:
switch(opc = q->b_expr.opcode) {
case OPCALL:
case OPCCALL:
if( ISCOMPLEX(q->vtype) )
p = putcxop(q);
else {
putcall(q);
p = callval;
}
break;
case OPMIN:
case OPMAX:
p = putmnmx(q);
break;
case OPASSIGN:
if (ISCOMPLEX(q->b_expr.leftp->vtype) ||
ISCOMPLEX(q->b_expr.rightp->vtype)) {
frexpr(putcxeq(q));
} else if (ISCHAR(q))
p = putcheq(q);
else
goto putopp;
break;
case OPEQ:
case OPNE:
if (ISCOMPLEX(q->b_expr.leftp->vtype) ||
ISCOMPLEX(q->b_expr.rightp->vtype) ) {
p = putcxcmp(q);
break;
}
case OPLT:
case OPLE:
case OPGT:
case OPGE:
if(ISCHAR(q->b_expr.leftp))
p = putchcmp(q);
else
goto putopp;
break;
case OPPOWER:
p = putpower(q);
break;
case OPSTAR:
/* m * (2**k) -> m<<k */
if (XINT(q->b_expr.leftp->vtype) &&
ISICON(q->b_expr.rightp) &&
((k = flog2(q->b_expr.rightp->b_const.fconst.ci))>0) ) {
q->b_expr.opcode = OPLSHIFT;
frexpr(q->b_expr.rightp);
q->b_expr.rightp = MKICON(k);
goto putopp;
}
case OPMOD:
goto putopp;
case OPPLUS:
case OPMINUS:
case OPSLASH:
case OPNEG:
if( ISCOMPLEX(q->vtype) )
p = putcxop(q);
else
goto putopp;
break;
case OPCONV:
if( ISCOMPLEX(q->vtype) )
p = putcxop(q);
else if (ISCOMPLEX(q->b_expr.leftp->vtype)) {
p = putx(mkconv(q->vtype,
realpart(putcx1(q->b_expr.leftp))));
ckfree(q);
} else
goto putopp;
break;
case OPAND:
/* Create logical AND */
x1 = fmktemp(TYLOGICAL, NULL);
putexpr(mkexpr(OPASSIGN, cpexpr(x1),
mklogcon(0)));
k = newlabel();
putif(q->b_expr.leftp, k);
putif(q->b_expr.rightp, k);
putexpr(mkexpr(OPASSIGN, cpexpr(x1),
mklogcon(1)));
putlabel(k);
p = putx(x1);
break;
case OPNOT: /* Logical NOT */
x1 = fmktemp(TYLOGICAL, NULL);
putexpr(mkexpr(OPASSIGN, cpexpr(x1),
mklogcon(1)));
k = newlabel();
putif(q->b_expr.leftp, k);
putexpr(mkexpr(OPASSIGN, cpexpr(x1),
mklogcon(0)));
putlabel(k);
p = putx(x1);
break;
case OPOR: /* Create logical OR */
x1 = fmktemp(TYLOGICAL, NULL);
putexpr(mkexpr(OPASSIGN, cpexpr(x1),
mklogcon(1)));
k = newlabel();
putif(mkexpr(OPEQ, q->b_expr.leftp,
mklogcon(0)), k);
putif(mkexpr(OPEQ, q->b_expr.rightp,
mklogcon(0)), k);
putexpr(mkexpr(OPASSIGN, cpexpr(x1),
mklogcon(0)));
putlabel(k);
p = putx(x1);
break;
case OPCOMMA:
for (x1 = q; x1->b_expr.opcode == OPCOMMA;
x1 = x1->b_expr.leftp)
putexpr(x1->b_expr.rightp);
p = putx(x1);
break;
case OPEQV:
case OPNEQV:
case OPADDR:
case OPBITOR:
case OPBITAND:
case OPBITXOR:
case OPBITNOT:
case OPLSHIFT:
case OPRSHIFT:
putopp:
p = putop(q);
break;
default:
fatal1("putx: invalid opcode %d", opc);
}
break;
case TADDR:
p = putaddr(q, YES);
break;
default:
fatal1("putx: impossible tag %d", q->tag);
}
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() );
}
/*
* Parse a function call
*
* For historical reasons, Postgres tries to treat the notations tab.col
* and col(tab) as equivalent: if a single-argument function call has an
* argument of complex type and the (unqualified) function name matches
* any attribute of the type, we take it as a column projection. Conversely
* a function of a single complex-type argument can be written like a
* column reference, allowing functions to act like computed columns.
*
* Hence, both cases come through here. The is_column parameter tells us
* which syntactic construct is actually being dealt with, but this is
* intended to be used only to deliver an appropriate error message,
* not to affect the semantics. When is_column is true, we should have
* a single argument (the putative table), unqualified function name
* equal to the column name, and no aggregate or variadic decoration.
*
* The argument expressions (in fargs) must have been transformed already.
*/
Node *
ParseFuncOrColumn(ParseState *pstate, List *funcname, List *fargs,
bool agg_star, bool agg_distinct, bool func_variadic,
WindowDef *over, bool is_column, int location)
{
Oid rettype;
Oid funcid;
ListCell *l;
ListCell *nextl;
Node *first_arg = NULL;
int nargs;
int nargsplusdefs;
Oid actual_arg_types[FUNC_MAX_ARGS];
Oid *declared_arg_types;
List *argdefaults;
Node *retval;
bool retset;
int nvargs;
FuncDetailCode fdresult;
/*
* Most of the rest of the parser just assumes that functions do not have
* more than FUNC_MAX_ARGS parameters. We have to test here to protect
* against array overruns, etc. Of course, this may not be a function,
* but the test doesn't hurt.
*/
if (list_length(fargs) > FUNC_MAX_ARGS)
ereport(ERROR,
(errcode(ERRCODE_TOO_MANY_ARGUMENTS),
errmsg_plural("cannot pass more than %d argument to a function",
"cannot pass more than %d arguments to a function",
FUNC_MAX_ARGS,
FUNC_MAX_ARGS),
parser_errposition(pstate, location)));
/*
* Extract arg type info in preparation for function lookup.
*
* If any arguments are Param markers of type VOID, we discard them from
* the parameter list. This is a hack to allow the JDBC driver to not
* have to distinguish "input" and "output" parameter symbols while
* parsing function-call constructs. We can't use foreach() because we
* may modify the list ...
*/
nargs = 0;
for (l = list_head(fargs); l != NULL; l = nextl)
{
Node *arg = lfirst(l);
Oid argtype = exprType(arg);
nextl = lnext(l);
if (argtype == VOIDOID && IsA(arg, Param) &&!is_column)
{
fargs = list_delete_ptr(fargs, arg);
continue;
}
actual_arg_types[nargs++] = argtype;
}
if (fargs)
{
first_arg = linitial(fargs);
Assert(first_arg != NULL);
}
/*
* Check for column projection: if function has one argument, and that
* argument is of complex type, and function name is not qualified, then
* the "function call" could be a projection. We also check that there
* wasn't any aggregate or variadic decoration.
*/
if (nargs == 1 && !agg_star && !agg_distinct && over == NULL &&
!func_variadic && list_length(funcname) == 1)
{
Oid argtype = actual_arg_types[0];
if (argtype == RECORDOID || ISCOMPLEX(argtype))
{
retval = ParseComplexProjection(pstate,
strVal(linitial(funcname)),
first_arg,
location);
if (retval)
return retval;
/*
* If ParseComplexProjection doesn't recognize it as a projection,
* just press on.
*/
}
}
/*
* Okay, it's not a column projection, so it must really be a function.
* func_get_detail looks up the function in the catalogs, does
* disambiguation for polymorphic functions, handles inheritance, and
* returns the funcid and type and set or singleton status of the
* function's return value. It also returns the true argument types to
* the function. In the case of a variadic function call, the reported
* "true" types aren't really what is in pg_proc: the variadic argument is
* replaced by a suitable number of copies of its element type. We'll fix
* it up below. We may also have to deal with default arguments.
*/
fdresult = func_get_detail(funcname, fargs, nargs, actual_arg_types,
!func_variadic, true,
&funcid, &rettype, &retset, &nvargs,
&declared_arg_types, &argdefaults);
if (fdresult == FUNCDETAIL_COERCION)
{
/*
* We interpreted it as a type coercion. coerce_type can handle these
* cases, so why duplicate code...
*/
return coerce_type(pstate, linitial(fargs),
actual_arg_types[0], rettype, -1,
COERCION_EXPLICIT, COERCE_EXPLICIT_CALL, location);
}
else if (fdresult == FUNCDETAIL_NORMAL)
{
/*
* Normal function found; was there anything indicating it must be an
* aggregate?
*/
if (agg_star)
ereport(ERROR,
(errcode(ERRCODE_WRONG_OBJECT_TYPE),
errmsg("%s(*) specified, but %s is not an aggregate function",
NameListToString(funcname),
NameListToString(funcname)),
parser_errposition(pstate, location)));
if (agg_distinct)
ereport(ERROR,
(errcode(ERRCODE_WRONG_OBJECT_TYPE),
errmsg("DISTINCT specified, but %s is not an aggregate function",
NameListToString(funcname)),
parser_errposition(pstate, location)));
if (over)
ereport(ERROR,
(errcode(ERRCODE_WRONG_OBJECT_TYPE),
errmsg("OVER specified, but %s is not a window function nor an aggregate function",
NameListToString(funcname)),
parser_errposition(pstate, location)));
}
else if (!(fdresult == FUNCDETAIL_AGGREGATE ||
fdresult == FUNCDETAIL_WINDOWFUNC))
{
/*
* Oops. Time to die.
*
* If we are dealing with the attribute notation rel.function, give an
* error message that is appropriate for that case.
*/
if (is_column)
{
Assert(nargs == 1);
Assert(list_length(funcname) == 1);
unknown_attribute(pstate, first_arg, strVal(linitial(funcname)),
location);
}
/*
* Else generate a detailed complaint for a function
*/
if (fdresult == FUNCDETAIL_MULTIPLE)
ereport(ERROR,
(errcode(ERRCODE_AMBIGUOUS_FUNCTION),
errmsg("function %s is not unique",
func_signature_string(funcname, nargs,
actual_arg_types)),
errhint("Could not choose a best candidate function. "
"You might need to add explicit type casts."),
parser_errposition(pstate, location)));
else
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_FUNCTION),
errmsg("function %s does not exist",
func_signature_string(funcname, nargs,
actual_arg_types)),
errhint("No function matches the given name and argument types. "
"You might need to add explicit type casts."),
parser_errposition(pstate, location)));
}
/*
* If there are default arguments, we have to include their types in
* actual_arg_types for the purpose of checking generic type consistency.
* However, we do NOT put them into the generated parse node, because
* their actual values might change before the query gets run. The
* planner has to insert the up-to-date values at plan time.
*/
nargsplusdefs = nargs;
foreach(l, argdefaults)
{
Node *expr = (Node *) lfirst(l);
/* probably shouldn't happen ... */
if (nargsplusdefs >= FUNC_MAX_ARGS)
ereport(ERROR,
(errcode(ERRCODE_TOO_MANY_ARGUMENTS),
errmsg_plural("cannot pass more than %d argument to a function",
"cannot pass more than %d arguments to a function",
FUNC_MAX_ARGS,
FUNC_MAX_ARGS),
parser_errposition(pstate, location)));
actual_arg_types[nargsplusdefs++] = exprType(expr);
}
putentries(FILE *outfile)
#endif
/* put out wrappers for multiple entries */
{
char base[IDENT_LEN];
struct Entrypoint *e;
Namep *A, *Ae, *Ae1, **Alp, *a, **a1, np;
chainp args, lengths;
int i, k, mt, nL, type;
extern char *dfltarg[], **dfltproc;
e = entries;
if (!e->enamep) /* only possible with erroneous input */
return;
nL = (nallargs + nallchargs) * sizeof(Namep *);
A = (Namep *)ckalloc(nL + nallargs*sizeof(Namep **));
Ae = A + nallargs;
Alp = (Namep **)(Ae1 = Ae + nallchargs);
i = k = 0;
for(a1 = Alp, args = allargs; args; a1++, args = args->nextp) {
np = (Namep)args->datap;
if (np->vtype == TYCHAR && np->vclass != CLPROC)
*a1 = &Ae[i++];
}
mt = multitype;
multitype = 0;
sprintf(base, "%s0_", e->enamep->cvarname);
do {
np = e->enamep;
lengths = length_comp(e, 0);
proctype = type = np->vtype;
if (protofile)
protowrite(protofile, type, np->cvarname, e, lengths);
nice_printf(outfile, "\n%s ", c_type_decl(type, 1));
nice_printf(outfile, "%s", np->cvarname);
if (!Ansi) {
listargs(outfile, e, 0, lengths);
nice_printf(outfile, "\n");
}
list_arg_types(outfile, e, lengths, 0, "\n");
nice_printf(outfile, "{\n");
frchain(&lengths);
next_tab(outfile);
if (mt)
nice_printf(outfile,
"Multitype ret_val;\n%s(%d, &ret_val",
base, k); /*)*/
else if (ISCOMPLEX(type))
nice_printf(outfile, "%s(%d,%s", base, k,
xretslot[type]->user.ident); /*)*/
else if (type == TYCHAR)
nice_printf(outfile,
"%s(%d, ret_val, ret_val_len", base, k); /*)*/
else
nice_printf(outfile, "return %s(%d", base, k); /*)*/
k++;
memset((char *)A, 0, nL);
for(args = e->arglist; args; args = args->nextp) {
np = (Namep)args->datap;
A[np->argno] = np;
if (np->vtype == TYCHAR && np->vclass != CLPROC)
*Alp[np->argno] = np;
}
args = allargs;
for(a = A; a < Ae; a++, args = args->nextp)
nice_printf(outfile, ", %s", (np = *a)
? np->cvarname
: ((Namep)args->datap)->vclass == CLPROC
? dfltproc[((Namep)args->datap)->vtype]
: dfltarg[((Namep)args->datap)->vtype]);
for(; a < Ae1; a++)
if (np = *a)
nice_printf(outfile, ", %s_len", np->fvarname);
else
nice_printf(outfile, ", (ftnint)0");
nice_printf(outfile, /*(*/ ");\n");
if (mt) {
if (type == TYCOMPLEX)
nice_printf(outfile,
"r_v->r = ret_val.c.r; r_v->i = ret_val.c.i;\n");
else if (type == TYDCOMPLEX)
nice_printf(outfile,
"r_v->r = ret_val.z.r; r_v->i = ret_val.z.i;\n");
else if (type <= TYLOGICAL)
nice_printf(outfile, "return ret_val.%s;\n",
postfix[type-TYINT1]);
}
nice_printf(outfile, "}\n");
prev_tab(outfile);
}
while(e = e->entnextp);
free((char *)A);
}
/*
* Parse a function call
*
* For historical reasons, Postgres tries to treat the notations tab.col
* and col(tab) as equivalent: if a single-argument function call has an
* argument of complex type and the (unqualified) function name matches
* any attribute of the type, we take it as a column projection. Conversely
* a function of a single complex-type argument can be written like a
* column reference, allowing functions to act like computed columns.
*
* Hence, both cases come through here. The is_column parameter tells us
* which syntactic construct is actually being dealt with, but this is
* intended to be used only to deliver an appropriate error message,
* not to affect the semantics. When is_column is true, we should have
* a single argument (the putative table), unqualified function name
* equal to the column name, and no aggregate decoration.
*
* The argument expressions (in fargs) must have been transformed already.
*/
Node *
ParseFuncOrColumn(ParseState *pstate, List *funcname, List *fargs,
bool agg_star, bool agg_distinct, bool is_column)
{
Oid rettype;
Oid funcid;
ListCell *l;
Node *first_arg = NULL;
int nargs = list_length(fargs);
int argn;
Oid actual_arg_types[FUNC_MAX_ARGS];
Oid *declared_arg_types;
Node *retval;
bool retset;
FuncDetailCode fdresult;
/*
* Most of the rest of the parser just assumes that functions do not
* have more than FUNC_MAX_ARGS parameters. We have to test here to
* protect against array overruns, etc. Of course, this may not be a
* function, but the test doesn't hurt.
*/
if (nargs > FUNC_MAX_ARGS)
ereport(ERROR,
(errcode(ERRCODE_TOO_MANY_ARGUMENTS),
errmsg("cannot pass more than %d arguments to a function",
FUNC_MAX_ARGS)));
if (fargs)
{
first_arg = linitial(fargs);
Assert(first_arg != NULL);
}
/*
* Check for column projection: if function has one argument, and that
* argument is of complex type, and function name is not qualified,
* then the "function call" could be a projection. We also check that
* there wasn't any aggregate decoration.
*/
if (nargs == 1 && !agg_star && !agg_distinct && list_length(funcname) == 1)
{
Oid argtype = exprType(first_arg);
if (argtype == RECORDOID || ISCOMPLEX(argtype))
{
retval = ParseComplexProjection(pstate,
strVal(linitial(funcname)),
first_arg);
if (retval)
return retval;
/*
* If ParseComplexProjection doesn't recognize it as a
* projection, just press on.
*/
}
}
/*
* Okay, it's not a column projection, so it must really be a
* function. Extract arg type info in preparation for function lookup.
*/
MemSet(actual_arg_types, 0, FUNC_MAX_ARGS * sizeof(Oid));
argn = 0;
foreach(l, fargs)
{
Node *arg = lfirst(l);
actual_arg_types[argn++] = exprType(arg);
}
doentry(struct Entrypoint *ep)
#endif
{
register int type;
register Namep np;
chainp p, p1;
register Namep q;
Addrp rs;
int it, k;
extern char dflttype[26];
Extsym *entryname = ep->entryname;
if (++nentry > 1)
p1_label((long)(extsymtab - entryname - 1));
/* The main program isn't allowed to have parameters, so any given
parameters are ignored */
if(procclass == CLMAIN && !ep->arglist || procclass == CLBLOCK)
return;
/* Entry points in MAIN are an error, but we process them here */
/* to prevent faults elsewhere. */
/* So now we're working with something other than CLMAIN or CLBLOCK.
Determine the type of its return value. */
impldcl( np = mkname(entryname->fextname) );
type = np->vtype;
proc_argchanges = prev_proc && type != entryname->extype;
entryname->extseen = 1;
if(proctype == TYUNKNOWN)
if( (proctype = type) == TYCHAR)
procleng = np->vleng ? np->vleng->constblock.Const.ci
: (ftnint) (-1);
if(proctype == TYCHAR)
{
if(type != TYCHAR)
err("noncharacter entry of character function");
/* Functions returning type char can only have multiple entries if all
entries return the same length */
else if( (np->vleng ? np->vleng->constblock.Const.ci :
(ftnint) (-1)) != procleng)
err("mismatched character entry lengths");
}
else if(type == TYCHAR)
err("character entry of noncharacter function");
else if(type != proctype)
multitype = YES;
if(rtvlabel[type] == 0)
rtvlabel[type] = (int)newlabel();
ep->typelabel = rtvlabel[type];
if(type == TYCHAR)
{
if(chslot < 0)
{
chslot = nextarg(TYADDR);
chlgslot = nextarg(TYLENG);
}
np->vstg = STGARG;
/* Put a new argument in the function, one which will hold the result of
a character function. This will have to be named sometime, probably in
mkarg(). */
if(procleng < 0) {
np->vleng = (expptr) mkarg(TYLENG, chlgslot);
np->vleng->addrblock.uname_tag = UNAM_IDENT;
strcpy (np -> vleng -> addrblock.user.ident,
new_func_length());
}
if (!xretslot[TYCHAR]) {
xretslot[TYCHAR] = rs =
autovar(0, type, ISCONST(np->vleng)
? np->vleng : ICON(0), "");
strcpy(rs->user.ident, "ret_val");
}
}
/* Handle a complex return type -- declare a new parameter (pointer to
a complex value) */
else if( ISCOMPLEX(type) ) {
if (!xretslot[type])
xretslot[type] =
autovar(0, type, EXNULL, " ret_val");
/* the blank is for use in out_addr */
np->vstg = STGARG;
if(cxslot < 0)
cxslot = nextarg(TYADDR);
}
else if (type != TYSUBR) {
if (type == TYUNKNOWN) {
dclerr("untyped function", np);
proctype = type = np->vtype =
dflttype[letter(np->fvarname[0])];
}
if (!xretslot[type])
xretslot[type] = retslot =
autovar(1, type, EXNULL, " ret_val");
/* the blank is for use in out_addr */
np->vstg = STGAUTO;
}
for(p = ep->arglist ; p ; p = p->nextp)
if(! (( q = (Namep) (p->datap) )->vknownarg) ) {
q->vknownarg = 1;
q->vardesc.varno = nextarg(TYADDR);
allargs = mkchain((char *)q, allargs);
q->argno = nallargs++;
}
else if (nentry == 1)
duparg(q);
else for(p1 = ep->arglist ; p1 != p; p1 = p1->nextp)
if ((Namep)p1->datap == q)
duparg(q);
k = 0;
for(p = ep->arglist ; p ; p = p->nextp) {
if(! (( q = (Namep) (p->datap) )->vdcldone) )
{
impldcl(q);
q->vdcldone = YES;
if(q->vtype == TYCHAR)
{
/* If we don't know the length of a char*(*) (i.e. a string), we must add
in this additional length argument. */
++nallchargs;
if (q->vclass == CLPROC)
nallchargs--;
else if (q->vleng == NULL) {
/* character*(*) */
q->vleng = (expptr)
mkarg(TYLENG, nextarg(TYLENG) );
unamstring((Addrp)q->vleng,
new_arg_length(q));
}
}
}
if (q->vdimfinish)
dim_finish(q);
if (q->vtype == TYCHAR && q->vclass != CLPROC)
k++;
}
if (entryname->extype != type)
changedtype(np);
/* save information for checking consistency of arg lists */
it = infertypes;
if (entryname->exproto)
infertypes = 1;
save_argtypes(ep->arglist, &entryname->arginfo, &np->arginfo,
0, np->fvarname, STGEXT, k, np->vtype, 2);
infertypes = it;
}
