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); } }