static void call_select_var(t_struct *st, va_list *list, char *str,
int *pos)
{
int i;
if (str[*pos] == '\n')
copy_into_buf(st, "\n", 1);
if (str[(*pos)++] != '%')
return;
for (i = 0; g_var_args[i].sym && g_var_args[i].sym != str[(*pos)]; i++);
if (!g_var_args[i].sym)
return ;
g_var_args[i].f(list, st);
++(*pos);
}
static void coerce_arg(rtype type, rtype ftype, int l, string code,
string *buf, int *i, int *lbuf,
int int_allowed, frame name)
{
frame f = make_frame(type, NULL, l, code, "");
if ((type == T_INTNUM || type == T_INTLNG) && !int_allowed)
f = coerce_frame(f, T_NUMBER);
f = coerce_frame(f, ftype);
if (f->decls)
name->decls = nconc(name->decls, copy_list(f->decls, 0));
NORET(f->code);
*buf = copy_into_buf(*buf, f->code, i, lbuf, strlen(f->code));
mcfree(f->code);
mcfree(f);
}
static frame make_regular_call_frame(frame name, frame args, string header,
int int_allowed, int kappafn)
{
char fname[ATOBUF_SIZE + 4];
string varg, next, n = NULL;
int i = 0;
string arg = strchr(header, ' ') + 1;
string rest = NULL;
string kappac = header[1] == STA ? "" : kappafn ? KPC : appfn_prefix;
string buf;
int lbuf = (args ? args->cl : 0) + 128;
int nnullp = strcmp(name->code, "Null?");
list delvars = NULL;
int bren = -1;
sprintf(fname, "%s%s", kappac, name->code);
if (!call_level && nnullp)
error(1, "Call level error while parsing call to '%s' in %s",
name->code, block_name);
if (!nnullp) --trilog;
--call_level;
if (parsing_rule_if && args && slotref_parsed & (1 << call_level))
{
if (strcmp(name->code, "KnownValue?") && nnullp)
warn("Suspicious call to '%s' in premise of rule %s",
name->code, block_name);
slotref_parsed &= ~(1 << call_level);
}
if (!arg[0])
return merge_frames(header[0], header[0], name, NULL, name->cl + 6,
RET, fname, "()", "");
buf = (string) mcalloc(lbuf);
varg = args ? argtok(args->code, &rest) : NULL;
if (header[0] == T_STRING)
{
MAKE_BUFFER(bname, SLOBUF);
sprintf(buf, "%s%s", bname, arg[1] ? ", " : "");
i = strlen(bname) + (arg[1] ? 2 : 0);
}
for (arg += (header[0] == T_STRING); arg[0]; varg = next) {
char arg0 = arg[0] & ~PTRF;
if (arg0 == T_HANDLE && arg[1] != VAGC)
{
next = varg;
strcpy(buf + i, "hInstance, ");
i += 11;
++arg;
continue;
}
if (varg)
{
next = argtok(rest, &rest);
n = (next ? next : varg + strlen(varg) + 1);
}
else
next = NULL;
if (varg && varg[0] != arg0) /* not the normal case. */
{
if (varg[0] == T_UNKNOWN || varg[0] == T_UNDEF)
{
if (varg[1] == UNOC) /* case of an unfinished function call. */
{
varg[2] = arg0;
buf = copy_into_buf(buf, varg + 1, &i, &lbuf,
n - varg - 2);
}
else
{
list m = member(varg, block_decls, 0, 0, 1, 1);
int vl = strlen(varg);
if (m) /* case of a variable of unknown type. */
{
if (car(m)[0] == T_UNKNOWN || car(m)[0] == T_UNDEF)
{
list a = member(varg, args->decls, 0, 0, 1, 1);
list b = member(varg, block_args, 0, 0, 1, 1);
list d = a ? NULL
: member(varg, delvars, 0, 0, 1, 1);
if (arg0 == T_STRING && !b)
{
buf[i++] = '"';
buf = copy_into_buf(buf, varg + 1, &i, &lbuf,
n - varg - 2);
buf[i++] = '"';
if (a && !d)
{
delvars = cons(car(a), delvars);
args->decls = delete(varg,
args->decls, 1, 1);
}
}
else
{
if (!b) /* declaring as atom or object. */
{
string tmp;
rtype dt =
arg0 == T_OBJECT ? T_OBJECT : T_ATOM;
tmp = create_adda_call(dt, varg, vl);
tmp[0] = dt;
if (a && car(m) == car(a))
{
mcfree(car(m));
car(m) = car(a) = tmp;
}
else
{
car(m) = tmp;
if (!a && d)
args->decls =
cons(car(d), args->decls);
}
}
else
{
if (a)
car(a)[0] = arg0;
else if (d)
{
car(d)[0] = arg0;
args->decls = cons(car(d),
args->decls);
}
car(m)[0] = arg0;
}
if (car(m)[0] == arg0)
goto normal;
else
goto coerce;
}
}
else coerce:
coerce_arg(car(m)[0], arg0, n - varg, varg + 1,
&buf, &i, &lbuf, int_allowed, name);
}
else /* case of a finished function */
{
string fn = strchr(varg + 1, '(');
int fl = fn - varg - 1 - appfn_pl;
m = member(varg, headers, 0, fl, appfn_pl + 1, 2);
coerce_arg(car(m)[0], arg0, n - varg, varg + 1,
&buf, &i, &lbuf, int_allowed, name);
#ifdef OLD
else if (user_headers.count)
{
char fname[48];
string *pr;
strncpy(fname, varg + appfn_pl + 1, fl);
fname[fl] = '\0';
pr = bsearch(&fname, user_headers.table,
user_headers.count,
sizeof(string), (sortfn) hcomp);
coerce_arg(*pr[0], arg0, n - varg, varg + 1,
&buf, &i, &lbuf, int_allowed, name);
}
#endif
}
}
}
else
{
int bd = arg0 == T_ATOM && varg[0] == T_OBJECT;
if (bren == -1 && bd)
bren = !strcmp(name->code, "RenameInstance") ||
!strcmp(name->code, "RenameClass");
if (bren == 1 && bd)
{
char nv1[32], nv2[32];
novar(nv1, varg + 1);
novar(nv2, name->code);
warn("%s was compiled as an object in call to %s, line %d.",
nv1, nv2, yylineno);
}
coerce_arg(varg[0], arg0, n - varg, varg + 1, &buf, &i,
&lbuf, int_allowed, name);
}
}
