void
varscale_ASL(ASL *asl, int i, real s, fint *ierror)
{
static char who[] = "varscale";
if (!asl
|| asl->i.ASLtype < ASL_read_fg
|| asl->i.ASLtype > ASL_read_pfgh)
badasl_ASL(asl, ASL_read_fg, who);
if (zcheck(asl, i, s, n_var, ierror, who))
return;
if (!asl->i.vscale)
asl->i.vscale = ones(asl, n_var);
scaleadj(s, i, 0, asl->i.vscale, LUv, Uvx, X0);
}
void
conscale_ASL(ASL *asl, int i, real s, fint *ierror)
{
static char who[] = "conscale";
if (!asl
|| asl->i.ASLtype < ASL_read_fg
|| asl->i.ASLtype > ASL_read_pfgh)
badasl_ASL(asl, ASL_read_fg, who);
if (zcheck(asl, i, s, n_con, ierror, who))
return;
if (s == 1.)
return;
if (!asl->i.cscale)
asl->i.cscale = ones(asl, n_con);
if (!asl->i.lscale)
asl->i.lscale = asl->i.cscale;
scaleadj(s, i, 1, asl->i.cscale, LUrhs, Urhsx, pi0);
if (asl->i.lscale != asl->i.cscale)
asl->i.lscale[i] *= s;
}
void
lagscale_ASL(ASL *asl, real s, fint *ierror)
{
static char who[] = "lagscale";
real *c, *l, *le;
size_t L;
if (!asl
|| (asl->i.ASLtype != ASL_read_pfgh
&& asl->i.ASLtype != ASL_read_fgh))
badasl_ASL(asl, ASL_read_pfgh, who);
if (zcheck(asl, 0, s, -1, ierror, who))
return;
if (s == 1.)
return;
if (!asl->i.lscale)
asl->i.lscale = ones(asl, n_con);
else if (asl->i.lscale == asl->i.cscale) {
L = n_con*sizeof(real);
memcpy(asl->i.lscale = (real*)mem_ASL(asl,L), asl->i.cscale, L);
}
l = asl->i.lscale;
le = l + n_con;
if ((c = asl->i.cscale)) {
while(l < le)
*l++ = s * *c++;
}
else
while(l < le)
*l++ *= s;
if ((c = pi0)) {
le = c + n_con;
s = 1. / s;
while(c < le)
*c++ *= s;
}
}
/*
** Mapfill fills the Map structure with the list
** of user supplied attributes. It then reads
** the list of relation attributes and checks
** for matching attribute names.
**
** if an error occures then mapfill returns -1
** else it returns 0
**
** Mapfill performs special processing on
** dummy domains.
**
** If no user attributes are given, then "given"=FALSE
** and each attribute in the relation is set up to be
** copied in the formats and order in which they
** exist in the relation
*/
int
mapfill(paramv_t *aptr)
{
register paramv_t *ap;
register struct map *mp;
register int i;
char *fp;
extern desc_t Attdes;
attr_t att;
struct tup_id tid, limtid;
int given, cnt;
Mapcount = 0;
mp = Map;
ap = aptr;
/* Gather list of user supplied attributes */
while (*(ap->pv_val.pv_str) != '\0') {
/* check for overflow */
if (Mapcount == MAXMAP)
return (error(TOOMANYATTR, 0)); /* more than MAXMAP specifiers */
mp->paramname = (ap->pv_val).pv_str; /* save pointer to user supplied name */
pmove(((ap++)->pv_val).pv_str, mp->name, MAX_NAME_SIZE, ' ');
fp = ((ap++)->pv_val).pv_str; /* fp points to format string */
mp->used = 0;
mp->rlen = 0; /* zero in case this is a dummy domain */
mp->roffset = 0;
mp->fdelim = 0;
/* check domain type in *fp */
switch (*fp++) {
case 'c':
i = CHAR_CONST;
if ((mp->fdelim = zcheck(fp)) == 0)
return (-1); /* bad delimitor */
break;
case 'f':
i = FLOAT_CONST;
break;
case 'i':
i = INT_CONST;
break;
case DUMMY:
i = DUMMY;
if ((mp->fdelim = zcheck(fp)) == 0)
return (-1);
break;
default:
return (error(BADATTRTYPE, mp->paramname, --fp, 0));
}
mp->ftype = i;
/* convert format length to binary */
mp->flen = atoi(fp);
if (mp->flen < 0 ||
mp->flen > 511 ||
(mp->ftype == FLOAT_CONST && mp->flen != 4 && mp->flen != 8) ||
(mp->ftype == INT_CONST && mp->flen != 1 && mp->flen != 2 && mp->flen != 4)) {
return (error(BADATTRLEN, mp->paramname, --fp, 0)); /* bad length for attribute */
}
/* process dummy domain if any */
if (Into && mp->ftype == DUMMY && mp->flen) {
if ((fp = dumvalue(mp->paramname)) == 0)
return (5807); /* bad dummy name */
mp->rtype = *fp; /* use first char of string */
}
/* check for format of type "c0delim" on copy "into" */
if (Into && mp->flen == 0 && mp->fdelim != Delimitor) {
fp = mp->fdelim;
/* is there room for a dummy domain? */
mp++;
if (++Mapcount == MAXMAP)
return (error(TOOMANYATTR, 0)); /* no room */
/* create a dummy entry */
mp->ftype = DUMMY;
mp->flen = 1;
mp->rtype = *fp;
mp->roffset = mp->rlen = 0;
}
mp++;
Mapcount++;
}
/* if no atributes were given, set flag */
if (Mapcount)
given = TRUE;
else
given = FALSE;
/* open attribute relation and prepare for scan */
opencatalog("attribute", OR_READ);
ingres_setkey(&Attdes, &att, Des.d_r.r_id, ATTRELID);
ingres_setkey(&Attdes, &att, Des.d_r.r_owner, ATTOWNER);
if (find(&Attdes, EXACTKEY, &tid, &limtid, &att))
syserr("find error for att-rel");
/* scan Map for each relation attribute */
while ((i = get(&Attdes, &tid, &limtid, &att, 1)) == 0) {
if (!bequal(&Des, &att, MAX_NAME_SIZE+2))
continue;
/* if no user attributes were supplied, fake an entry */
if (!given) {
Mapcount++;
mp = &Map[att.a_id -1];
mp->rtype = mp->ftype = att.a_fmt;
mp->rlen = mp->flen = att.a_len & I1MASK;
mp->roffset = att.a_off;
mp->used = 1;
mp->paramname = mp->name; /* point to name */
bmove(att.a_name, mp->name, MAX_NAME_SIZE); /* copy name */
continue;
}
mp = Map;
/* check each user domain for match with relation domain */
for (i = Mapcount; i--; mp++) {
if (mp->ftype == DUMMY)
continue; /* ignore dummy */
if (!bequal(mp->name, att.a_name, 12))
continue;
mp->rtype = att.a_fmt;
mp->rlen = att.a_len & I1MASK;
mp->roffset = att.a_off;
mp->used++;
/* check for special case of C0 in a copy "into" */
if (Into && (mp->flen == 0) && mp->ftype == CHAR_CONST) {
switch (mp->rtype) {
case CHAR_CONST:
mp->flen = mp->rlen;
break;
case INT_CONST:
switch (mp->rlen) {
case 1:
mp->flen = Out_arg.i1width;
break;
case 2:
mp->flen = Out_arg.i2width;
break;
case 4:
mp->flen = Out_arg.i4width;
}
break;
case FLOAT_CONST:
if (mp->rlen == 4)
mp->flen = Out_arg.f4width;
else
mp->flen = Out_arg.f8width;
}
}
/* if this is a copy "from" then break
otherwise continue. In a copy "into"
an attribute might be copied more than once */
if (!Into)
break;
}
}
if (i < 0)
syserr("bad get from att-rel %d", i);
/* check that all user domains have been identified */
cnt = 0;
mp = Map;
for (i = Mapcount; i--; mp++) {
cnt += mp->flen;
if (mp->ftype == DUMMY)
continue;
if (!mp->used) {
if ( Into && bequal(mp->name,"tid ",12) ) {
mp->flen = 4;
mp->rtype = INT_CONST;
mp->rlen = 4;
mp->roffset = -1;
mp->used++;
}
else
return (error(ATTRNOEXIST, mp->paramname, Relname, 0)); /* unrecognizable domain name */
}
}
/* check that copy into doesn't exceed buffer size */
if (Into && cnt > BUFSIZ)
return (error(FILETOOWIDE, 0)); /* cnt too large */
return (0);
}
