home *** CD-ROM | disk | FTP | other *** search
- /*
- o_arith.c
- */
- /* Copyright (c) 1994 Christian F. Tschudin. All rights reserved.
-
- Distributed under the terms of the GNU General Public License
- version 2 of june 1991 as published by the Free Software
- Foundation, Inc.
-
- This file is part of M0.
-
- M0 is distributed in the hope that it will be useful, but WITHOUT ANY
- WARRANTY. No author or distributor accepts responsibility to anyone for
- the consequences of using it or for whether it serves any particular
- purpose or works at all, unless he says so in writing. Refer to the GNU
- General Public License for full details.
-
- Everyone is granted permission to copy, modify and redistribute M0, but
- only under the conditions described in the GNU General Public License.
- A copy of this license is supposed to have been given to you along with
- M0 so you can know your rights and responsibilities. It should be in a
- file named LICENSE. Among other things, the copyright notice and this
- notice must be preserved on all copies. */
-
- #include "l_proto.h"
- #include "o_proto.h"
-
- /* data types and possible operations:
- array array +
- string string + > <
- time time - > <
- time int + -
- int ~
- int int + - * / < > | & ^ %
- int time +
- key ~
- key key | & ^
- any any =
- */
-
-
- /* functions for integer types: */
-
- static retcode divide(sint a, sint b, sint *r)
- { if (!b) return ERR_DIVISION_BY_ZERO; *r = a/b; return OK; }
- static retcode mod(sint a, sint b, sint *r)
- { if (!b) return ERR_DIVISION_BY_ZERO; *r = a%b; return OK; }
- static retcode mul(sint a, sint b, sint *r) { *r = a*b; return OK; }
-
-
- static retcode
- do_binary(retcode (*fct)(sint a, sint b, sint *r))
- {
- eindex res;
- sint v;
- retcode rc;
-
- load_2_args(a, b, ap, bp);
-
- if (eptype(ap) != T_INT || eptype(bp) != T_INT)
- return ERR_TYPE_CHECK;
- rc = fct(ap->V.i, bp->V.i, &v);
- if (rc != OK)
- return rc;
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = v;
-
- decrefp(current, a, ap);
- decrefp(current, b, bp);
- return_ok_result(2, res);
- }
-
-
- retcode o_div() { return do_binary(divide); }
- retcode o_mod() { return do_binary(mod); }
- retcode o_mul() { return do_binary(mul); }
-
-
- /* ------------------------------------------------------------------------- */
-
- retcode o_add()
- {
- eindex res;
- eptr rp;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT) {
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = p1->V.i + p2->V.i;
- } else if (eptype(p1) == T_STRING && eptype(p2) == T_STRING) {
- res = new_element(current, T_STRING);
- rp = eaddr(current, res);
- epattr(rp) = A_FRAG | (A_ALL & epattr(p1) & epattr(p2));
- rp->V.fra.f[0] = e1;
- rp->V.fra.f[1] = e2;
- eplen(rp) = eplen(p1)+eplen(p2);
- increfp(p1);
- increfp(p2);
- } else if (eptype(p1) == T_ARRAY && eptype(p2) == T_ARRAY) {
- int i, j;
- res = new_array(current, eplen(p1)+eplen(p2));
-
- for (i = 0; i < eplen(p1); i++)
- array_put(current, res, i, array_get(current, e1, i));
- for (i = 0, j = eplen(p1); i < eplen(p2); i++, j++)
- array_put(current, res, j, array_get(current, e2, i));
- } else if (eptype(p1) == T_TIME && eptype(p2) == T_INT)
- res = time_addint(current, e1, p2->V.i);
- else if (eptype(p1) == T_INT && eptype(p2) == T_TIME)
- res = time_addint(current, e2, p1->V.i);
- else
- return ERR_TYPE_CHECK;
-
- rp = eaddr(current, res);
- if (eptype(rp) == T_STRING || eptype(rp) == T_ARRAY || eptype(rp) == T_TIME)
- epattr(rp) &= ~A_ALL | (epattr(p1) & epattr(p2));
-
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-
-
- retcode o_and()
- {
- eindex res;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT) {
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = p1->V.i & p2->V.i;
- } else if (eptype(p1) == T_KEY && eptype(p2) == T_KEY) {
- byteptr s = p2->V.nam.u.s;
- byte k[8];
- int i;
- memcpy(k, (char*)(p1->V.nam.u.s), 8);
- for (i = 0; i < 8; i++, s++)
- k[i] &= *s;
- res = key_add(k);
- } else
- return ERR_TYPE_CHECK;
-
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-
-
- retcode o_eq()
- {
- eindex e1, e2, ei;
-
- if (current->osp < 2)
- return ERR_STACK_UNDERFLOW;
- e1 = current->os[current->osp-2];
- e2 = current->os[current->osp-1];
-
- ei = new_element(current, T_INT);
- eaddr(current, ei)->V.i = element_equal(current, e1, e2);
-
- decref(current, e1);
- decref(current, e2);
- return_ok_result(2, ei);
- }
-
-
- retcode o_gt()
- {
- int flag;
- eindex res;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT)
- flag = p1->V.i > p2->V.i ? 1 : 0;
- else if (eptype(p1) == T_TIME && eptype(p2) == T_TIME) {
- if (!(epattr(p1) & epattr(p2) & A_READ))
- return ERR_ACCESS_CHECK;
- flag = time_gt(&(p1->V.tim), &(p2->V.tim));
- } else if (eptype(p1) == T_STRING && eptype(p2) == T_STRING) {
- if (!(epattr(p1) & epattr(p2) & A_READ))
- return ERR_ACCESS_CHECK;
- flag = str_gt(current, e1, e2);
- } else
- return ERR_TYPE_CHECK;
-
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = flag;
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-
-
- retcode o_lt()
- {
- int flag;
- eindex res;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT)
- flag = p1->V.i < p2->V.i ? 1 : 0;
- else if (eptype(p1) == T_TIME && eptype(p2) == T_TIME) {
- if (!(epattr(p1) & epattr(p2) & A_READ))
- return ERR_ACCESS_CHECK;
- flag = time_gt(&(p2->V.tim), &(p1->V.tim));
- } else if (eptype(p1) == T_STRING && eptype(p2) == T_STRING) {
- if (!(epattr(p1) & epattr(p2) & A_READ))
- return ERR_ACCESS_CHECK;
- flag = str_gt(current, e2, e1);
- } else
- return ERR_TYPE_CHECK;
-
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = flag;
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-
-
- retcode o_neg()
- {
- eindex res;
-
- load_1_arg(ei, ep);
-
- if (eptype(ep) != T_INT)
- return ERR_TYPE_CHECK;
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = - ep->V.i;
- decrefp(current, ei, ep);
-
- current->os[current->osp-1] = res;
- return OK;
- }
-
-
- retcode o_not()
- {
- eindex res;
-
- load_1_arg(e1, p1);
-
- if (eptype(p1) == T_INT) {
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = ~(p1->V.i);
- } else if (eptype(p1) == T_KEY) {
- byteptr s = p1->V.nam.u.s;
- byte k[8];
- int i;
- for (i = 0; i < 8; i++)
- k[i] = ~*s;
- res = key_add(k);
- } else
- return ERR_TYPE_CHECK;
-
- decrefp(current, e1, p1);
- return_ok_result(1, res);
- }
-
-
- retcode o_or()
- {
- eindex res;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT) {
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = p1->V.i | p2->V.i;
- } else if (eptype(p1) == T_KEY && eptype(p2) == T_KEY) {
- byteptr s = p2->V.nam.u.s;
- byte k[8];
- int i;
- memcpy(k, (char*)(p1->V.nam.u.s), 8);
- for (i = 0; i < 8; i++, s++)
- k[i] |= *s;
- res = key_add(k);
- } else
- return ERR_TYPE_CHECK;
-
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-
-
- retcode o_sub()
- {
- eindex res;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT) {
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = p1->V.i - p2->V.i;
- } else if (eptype(p1) == T_TIME && eptype(p2) == T_TIME) {
- if (!(epattr(p1) & epattr(p2) & A_READ))
- return ERR_ACCESS_CHECK;
- res = time_diff(current, e1, e2);
- } else if (eptype(p1) == T_TIME && eptype(p2) == T_INT) {
- if (!(epattr(p1) & A_READ))
- return ERR_ACCESS_CHECK;
- res = time_addint(current, e1, - p2->V.i);
- } else
- return ERR_TYPE_CHECK;
-
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-
-
- retcode o_xor()
- {
- eindex res;
-
- load_2_args(e1, e2, p1, p2);
-
- if (eptype(p1) == T_INT && eptype(p2) == T_INT) {
- res = new_element(current, T_INT);
- eaddr(current, res)->V.i = p1->V.i ^ p2->V.i;
- } else if (eptype(p1) == T_KEY && eptype(p2) == T_KEY) {
- byteptr s = p2->V.nam.u.s;
- byte k[8];
- int i;
- memcpy(k, (char*)(p1->V.nam.u.s), 8);
- for (i = 0; i < 8; i++, s++)
- k[i] ^= *s;
- res = key_add(k);
- } else
- return ERR_TYPE_CHECK;
-
- decrefp(current, e1, p1);
- decrefp(current, e2, p2);
- return_ok_result(2, res);
- }
-