int what_is_this_glue(char *buff)
{
int i;
int total;
int ref;
i = 1;
while (i <= 5)
{
total = total + match(recup_colle(i), str_to_tab(buff, tab_height(buff), tab_length(buff)),
tab_height(buff), tab_length(buff)), i, tab_height(buff), tab_length(buff);
i = i + 1;
}
if (total == 0)
no_result();
i = 1;
while (i <= 5)
{
ref = total;
aff_result(match(recup_colle(i), str_to_tab(buff, tab_height(buff), tab_length(buff)),
tab_height(buff), tab_length(buff)), i, tab_height(buff), tab_length(buff));
total = total - match(recup_colle(i), str_to_tab(buff, tab_height(buff), tab_length(buff)),
tab_height(buff), tab_length(buff)), i, tab_height(buff), tab_length(buff);
if (total != ref && total != 0)
double_result();
i = i + 1;
}
}
/* <dnum1> <dnum2> <dresult> .ddiv <dresult> */
static int
zddiv(i_ctx_t *i_ctx_p)
{
dbegin_binary();
if (num[1] == 0.0)
return_error(e_undefinedresult);
return double_result(i_ctx_p, 2, num[0] / num[1]);
}
static int
dlog(i_ctx_t *i_ctx_p, double (*lfunc)(double))
{
dbegin_unary();
if (num <= 0.0)
return_error(e_rangecheck);
return double_result(i_ctx_p, 1, (*lfunc)(num));
}
/* <dnum> <dresult> .dsqrt <dresult> */
static int
zdsqrt(i_ctx_t *i_ctx_p)
{
dbegin_unary();
if (num < 0.0)
return_error(e_rangecheck);
return double_result(i_ctx_p, 1, sqrt(num));
}
/* <dbase> <dexponent> <dresult> .dexp <dresult> */
static int
zdexp(i_ctx_t *i_ctx_p)
{
double ipart;
dbegin_binary();
if (num[0] == 0.0 && num[1] == 0.0)
return_error(e_undefinedresult);
if (num[0] < 0.0 && modf(num[1], &ipart) != 0.0)
return_error(e_undefinedresult);
return double_result(i_ctx_p, 2, pow(num[0], num[1]));
}
/* <dnum> <ddenom> <dresult> .datan <dresult> */
static int
zdatan(i_ctx_t *i_ctx_p)
{
double result;
dbegin_binary();
if (num[0] == 0) { /* on X-axis, special case */
if (num[1] == 0)
return_error(e_undefinedresult);
result = (num[1] < 0 ? 180 : 0);
} else {
result = atan2(num[0], num[1]) * radians_to_degrees;
if (result < 0)
result += 360;
}
return double_result(i_ctx_p, 2, result);
}
/* <string> <dresult> .cvsd <dresult> */
static int
zcvsd(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code = double_params_result(op, 0, NULL);
double num;
char dot, buf[MAX_CHARS + 2];
char *str = buf;
uint len;
char end;
if (code < 0)
return code;
check_read_type(op[-1], t_string);
len = r_size(op - 1);
if (len > MAX_CHARS)
return_error(e_limitcheck);
sprintf(buf, "%f", 1.5);
dot = buf[1]; /* locale-dependent */
memcpy(str, op[-1].value.bytes, len);
/*
* We check syntax in the following way: we remove whitespace,
* verify that the string contains only [0123456789+-.dDeE],
* then append a $ and then check that the next character after
* the scanned number is a $.
*/
while (len > 0 && isspace(*str))
++str, --len;
while (len > 0 && isspace(str[len - 1]))
--len;
str[len] = 0;
if (strspn(str, "0123456789+-.dDeE") != len)
return_error(e_syntaxerror);
strcat(str, "$");
if (dot != '.') {
char *pdot = strchr(str, '.');
if (pdot)
*pdot = dot;
}
if (sscanf(str, "%lf%c", &num, &end) != 2 || end != '$')
return_error(e_syntaxerror);
return double_result(i_ctx_p, 1, num);
}
/* <dnum1> <dnum2> <dresult> .dsub <dresult> */
static int
zdsub(i_ctx_t *i_ctx_p)
{
dbegin_binary();
return double_result(i_ctx_p, 2, num[0] - num[1]);
}
/* Apply a unary function to a double operand. */
static int
double_unary(i_ctx_t *i_ctx_p, double (*func)(double))
{
dbegin_unary();
return double_result(i_ctx_p, 1, (*func)(num));
}
/* <dnum> <dresult> .cvd <dresult> */
static int
zcvd(i_ctx_t *i_ctx_p)
{
dbegin_unary();
return double_result(i_ctx_p, 1, num);
}
static int
darc(i_ctx_t *i_ctx_p, double (*afunc)(double))
{
dbegin_unary();
return double_result(i_ctx_p, 1, (*afunc)(num) * radians_to_degrees);
}
/* <dnum> <dresult> .dtruncate <dresult> */
static int
zdtruncate(i_ctx_t *i_ctx_p)
{
dbegin_unary();
return double_result(i_ctx_p, 1, (num < 0 ? ceil(num) : floor(num)));
}
/* <dnum> <dresult> .dround <dresult> */
static int
zdround(i_ctx_t *i_ctx_p)
{
dbegin_unary();
return double_result(i_ctx_p, 1, floor(num + 0.5));
}
/* <dnum> <dresult> .dneg <dresult> */
static int
zdneg(i_ctx_t *i_ctx_p)
{
dbegin_unary();
return double_result(i_ctx_p, 1, -num);
}
