/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */

/*
    num_log.c  -- Logical operations on numbers.
*/
/*
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
    Copyright (c) 1990, Giuseppe Attardi.
    Copyright (c) 2001, Juan Jose Garcia Ripoll.

    ECL is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    See file '../Copyright' for full details.
*/

#include <ecl/ecl.h>
#include <stdlib.h>
#include <ecl/internal.h>

/*
 * BIT OPERATIONS FOR FIXNUMS
 */

static cl_fixnum
ior_op(cl_fixnum i, cl_fixnum j)
{
        return(i | j);
}

static cl_fixnum
xor_op(cl_fixnum i, cl_fixnum j)
{
        return(i ^ j);
}

static cl_fixnum
and_op(cl_fixnum i, cl_fixnum j)
{
        return(i & j);
}

static cl_fixnum
eqv_op(cl_fixnum i, cl_fixnum j)
{
        return(~(i ^ j));
}

static cl_fixnum
nand_op(cl_fixnum i, cl_fixnum j)
{
        return(~(i & j));
}

static cl_fixnum
nor_op(cl_fixnum i, cl_fixnum j)
{
        return(~(i | j));
}

static cl_fixnum
andc1_op(cl_fixnum i, cl_fixnum j)
{
        return((~i) & j);
}

static cl_fixnum
andc2_op(cl_fixnum i, cl_fixnum j)
{
        return(i & (~j));
}

static cl_fixnum
orc1_op(cl_fixnum i, cl_fixnum j)
{
        return((~i) | j);
}

static cl_fixnum
orc2_op(cl_fixnum i, cl_fixnum j)
{
        return(i | (~j));
}

static cl_fixnum
b_clr_op(cl_fixnum i, cl_fixnum j)
{
        return(0);
}

static cl_fixnum
b_set_op(cl_fixnum i, cl_fixnum j)
{
        return(-1);
}

static cl_fixnum
b_1_op(cl_fixnum i, cl_fixnum j)
{
        return(i);
}

static cl_fixnum
b_2_op(cl_fixnum i, cl_fixnum j)
{
        return(j);
}

static cl_fixnum
b_c1_op(cl_fixnum i, cl_fixnum j)
{
        return(~i);
}

static cl_fixnum
b_c2_op(cl_fixnum i, cl_fixnum j)
{
        return(~j);
}

typedef cl_fixnum (*bit_operator)(cl_fixnum, cl_fixnum);

static bit_operator fixnum_operations[16] = {
        b_clr_op,
        and_op,
        andc2_op,
        b_1_op,
        andc1_op,
        b_2_op,
        xor_op,
        ior_op,
        nor_op,
        eqv_op,
        b_c2_op,
        orc2_op,
        b_c1_op,
        orc1_op,
        nand_op,
        b_set_op};


static cl_object
log_op(cl_narg narg, int op, ecl_va_list ARGS)
{
        cl_object x, y;
        /* FIXME! This can be optimized */
        x = ecl_va_arg(ARGS);
        if (narg-- == 1) {
                assert_type_integer(x);
        } else {
                do {
                        y = ecl_va_arg(ARGS);
                        x = ecl_boole(op, x, y);
                } while (--narg);
        }
        return x;
}

cl_object
ecl_boole(int op, cl_object x, cl_object y)
{
        switch (ecl_t_of(x)) {
        case t_fixnum:
                switch (ecl_t_of(y)) {
                case t_fixnum: {
                        cl_fixnum z = fixnum_operations[op](ecl_fixnum(x), ecl_fixnum(y));
                        return ecl_make_fixnum(z);
                }
                case t_bignum: {
                        cl_object x_copy = _ecl_big_register0();
                        _ecl_big_set_fixnum(x_copy, ecl_fixnum(x));
                        (_ecl_big_boole_operator(op))(x_copy, x_copy, y);
                        return _ecl_big_register_normalize(x_copy);
                }
                default:
                        FEwrong_type_nth_arg(@[boole], 2, y, @[integer]);
                }
                break;
        case t_bignum: {
                cl_object x_copy = _ecl_big_register0();
                switch (ecl_t_of(y)) {
                case t_fixnum: {
                        cl_object z = _ecl_big_register1();
                        _ecl_big_set_fixnum(z,ecl_fixnum(y));
                        (_ecl_big_boole_operator(op))(x_copy, x, z);
                        _ecl_big_register_free(z);
                        break;
                }
                case t_bignum:
                        (_ecl_big_boole_operator(op))(x_copy, x, y);
                        break;
                default:
                        FEwrong_type_nth_arg(@[boole], 2, y, @[integer]);
                }
                return _ecl_big_register_normalize(x_copy);
        }
        default:
                FEwrong_type_nth_arg(@[boole], 1, x, @[integer]);
        }
        return x;
}

cl_object
cl_lognot(cl_object x)
{
        return @logxor(2,x,ecl_make_fixnum(-1));
}

static cl_fixnum
count_bits(cl_object x)
{
        cl_fixnum count;

        switch (ecl_t_of(x)) {
        case t_fixnum: {
                cl_fixnum i = ecl_fixnum(x);
                cl_fixnum j = (i < 0) ? ~i : i;
                for (count=0 ; j ; j >>= 1)
                        if (j & 1) count++;
                break;
        }
        case t_bignum:
                if (_ecl_big_sign(x) >= 0)
                        count = mpz_popcount(x->big.big_num);
                else {
                        cl_object z = _ecl_big_register0();
                        mpz_com(z->big.big_num, x->big.big_num);
                        count = mpz_popcount(z->big.big_num);
                        _ecl_big_register_free(z);
                }
                break;
        default:
                FEwrong_type_only_arg(@[logcount], x, @[integer]);
        }
        return count;
}

/*
   Left shift if w > 0, right shift if w < 0.
 */
cl_object
ecl_ash(cl_object x, cl_fixnum w)
{
        cl_object y;

        if (w == 0)
                return(x);
        y = _ecl_big_register0();
        if (w < 0) {
                cl_index bits = -w;
                if (ECL_FIXNUMP(x)) {
                        /* The result of shifting a number further than the number
                         * of digits it has is unpredictable in C. For instance, GCC
                         * on intel masks out all bits of "bits" beyond the 5 and
                         * it may happen that a shift of 37 becomes a shift of 5.
                         * Furthermore, in general, shifting negative numbers leads
                         * to implementation-specific results :-/
                         */
                        cl_fixnum y = ecl_fixnum(x);
                        if (bits >= ECL_FIXNUM_BITS) {
                                y = (y < 0)? -1 : 0;
                        } else {
                                y >>= bits;
                        }
                        return ecl_make_fixnum(y);
                }
                mpz_div_2exp(y->big.big_num, x->big.big_num, bits);
        } else {
                if (ECL_FIXNUMP(x)) {
                        _ecl_big_set_fixnum(y, ecl_fixnum(x));
                        x = y;
                }
                mpz_mul_2exp(y->big.big_num, x->big.big_num, (unsigned long)w);
        }
        return _ecl_big_register_normalize(y);
}

int
ecl_fixnum_bit_length(cl_fixnum i)
{
        int count;
        if (i < 0)
                i = ~i;
        for (count = 0; i && (count < ECL_FIXNUM_BITS); i >>= 1, count++)
                ;
        return count;
}

@(defun logior (&rest nums)
@
        if (narg == 0)
                @(return ecl_make_fixnum(0))
        /* INV: log_op() checks types and outputs first argument as default. */
        @(return log_op(narg, ECL_BOOLIOR, nums))
@)

@(defun logxor (&rest nums)
@
        if (narg == 0)
                @(return ecl_make_fixnum(0))
        /* INV: log_op() checks types and outputs first argument as default. */
        @(return log_op(narg, ECL_BOOLXOR, nums))
@)

@(defun logand (&rest nums)
@
        if (narg == 0)
                @(return ecl_make_fixnum(-1))
        /* INV: log_op() checks types and outputs first argument as default. */
        @(return log_op(narg, ECL_BOOLAND, nums))
@)

@(defun logeqv (&rest nums)
@
        if (narg == 0)
                @(return ecl_make_fixnum(-1))
        /* INV: log_op() checks types and outputs first argument as default. */
        @(return log_op(narg, ECL_BOOLEQV, nums))
@)

cl_object
cl_lognand(cl_object x, cl_object y)
{
        @(return ecl_boole(ECL_BOOLNAND, x, y))
}

cl_object
cl_lognor(cl_object x, cl_object y)
{
        @(return ecl_boole(ECL_BOOLNOR, x, y))
}

cl_object
cl_logandc1(cl_object x, cl_object y)
{
        @(return ecl_boole(ECL_BOOLANDC1, x, y))
}

cl_object
cl_logandc2(cl_object x, cl_object y)
{
        @(return ecl_boole(ECL_BOOLANDC2, x, y))
}

cl_object
cl_logorc1(cl_object x, cl_object y)
{
        @(return ecl_boole(ECL_BOOLORC1, x, y))
}

cl_object
cl_logorc2(cl_object x, cl_object y)
{
        @(return ecl_boole(ECL_BOOLORC2, x, y))
}

static int
coerce_to_logical_operator(cl_object o)
{
        cl_fixnum op;
        op = ecl_to_fix(o);
        if (op < 0 || op > ECL_BOOLSET)
                FEerror("~S is an invalid logical operator.", 1, o);
        return op;
}

cl_object
cl_boole(cl_object o, cl_object x, cl_object y)
{
        /* INV: log_op2() checks types */
        @(return ecl_boole(coerce_to_logical_operator(o), x, y))
}

cl_object
cl_logbitp(cl_object p, cl_object x)
{
        bool i;

        assert_type_integer(x);
        if (ECL_FIXNUMP(p)) {
                cl_index n = ecl_to_size(p);
                if (ECL_FIXNUMP(x)) {
                        cl_fixnum y = ecl_fixnum(x);
                        if (n >= ECL_FIXNUM_BITS) {
                                i = (y < 0);
                        } else {
                                i = ((y >> n) & 1);
                        }
                } else {
                        i = mpz_tstbit(x->big.big_num, n);
                }
        } else {
                assert_type_non_negative_integer(p);
                if (ECL_FIXNUMP(x))
                        i = (ecl_fixnum(x) < 0);
                else
                        i = (_ecl_big_sign(x) < 0);
        }
        @(return (i ? ECL_T : ECL_NIL))
}

cl_object
cl_ash(cl_object x, cl_object y)
{
        cl_object r;
        int sign_x;

        assert_type_integer(x);
        assert_type_integer(y);
        if (ECL_FIXNUMP(y))
          r = ecl_ash(x, ecl_fixnum(y));
        else {
          /*
            bit position represented by bignum is probably
            out of our address space. So, result is returned
            according to sign of integer.
            */
          if (ECL_FIXNUMP(x))
            if (ecl_fixnum_minusp(x))
              sign_x = -1;
            else if (x == ecl_make_fixnum(0))
              sign_x = 0;
            else
              sign_x = 1;
          else
            sign_x = _ecl_big_sign(x);
          if (_ecl_big_sign(y) < 0)
            if (sign_x < 0)
              r = ecl_make_fixnum(-1);
            else
              r = ecl_make_fixnum(0);
          else if (sign_x == 0)
            r = x;
          else
            FEerror("Insufficient memory.", 0);
        }
        @(return r)
}

cl_object
cl_logcount(cl_object x)
{
        @(return ecl_make_fixnum(count_bits(x)))
}

cl_index
ecl_integer_length(cl_object x)
{
        int count;
        cl_fixnum i;

        switch (ecl_t_of(x)) {
        case t_fixnum:
                i = ecl_fixnum(x);
                count = ecl_fixnum_bit_length(i);
                break;
        case t_bignum:
                if (_ecl_big_sign(x) < 0)
                        x = cl_lognot(x);
                count = mpz_sizeinbase(x->big.big_num, 2);
                break;
        default:
                FEwrong_type_only_arg(@[integer-length], x, @[integer]);
        }
        return count;
}

cl_object
cl_integer_length(cl_object x)
{
        @(return ecl_make_fixnum(ecl_integer_length(x)))
}

cl_object
si_bit_array_op(cl_object o, cl_object x, cl_object y, cl_object r)
{
        cl_fixnum i, j, n, d;
        cl_object r0;
        bit_operator op;
        bool replace = FALSE;
        int xi, yi, ri;
        byte *xp, *yp, *rp;
        int xo, yo, ro;

        if (ecl_t_of(x) == t_bitvector) {
                d = x->vector.dim;
                xp = x->vector.self.bit;
                xo = x->vector.offset;
                if (ecl_t_of(y) != t_bitvector)
                        goto ERROR;
                if (d != y->vector.dim)
                        goto ERROR;
                yp = y->vector.self.bit;
                yo = y->vector.offset;
                if (r == ECL_T)
                        r = x;
                if (r != ECL_NIL) {
                        if (ecl_t_of(r) != t_bitvector)
                                goto ERROR;
                        if (r->vector.dim != d)
                                goto ERROR;
                        i = (r->vector.self.bit - xp)*8 + (r->vector.offset - xo);
                        if ((i > 0 && i < d) || (i < 0 && -i < d)) {
                                r0 = r;
                                r = ECL_NIL;
                                replace = TRUE;
                                goto L1;
                        }
                        i = (r->vector.self.bit - yp)*8 + (r->vector.offset - yo);
                        if ((i > 0 && i < d) || (i < 0 && -i < d)) {
                                r0 = r;
                                r = ECL_NIL;
                                replace = TRUE;
                        }
                }
        L1:
                if (Null(r)) {
                        r = ecl_alloc_simple_vector(d, ecl_aet_bit);
                }
        } else {
                if (ecl_t_of(x) != t_array)
                        goto ERROR;
                if ((cl_elttype)x->array.elttype != ecl_aet_bit)
                        goto ERROR;
                d = x->array.dim;
                xp = x->vector.self.bit;
                xo = x->vector.offset;
                if (ecl_t_of(y) != t_array)
                        goto ERROR;
                if ((cl_elttype)y->array.elttype != ecl_aet_bit)
                        goto ERROR;
                if (x->array.rank != y->array.rank)
                        goto ERROR;
                yp = y->vector.self.bit;
                yo = y->vector.offset;
                for (i = 0;  i < x->array.rank;  i++)
                        if (x->array.dims[i] != y->array.dims[i])
                                goto ERROR;
                if (r == ECL_T)
                        r = x;
                if (r != ECL_NIL) {
                        if (ecl_t_of(r) != t_array)
                                goto ERROR;
                        if ((cl_elttype)r->array.elttype != ecl_aet_bit)
                                goto ERROR;
                        if (r->array.rank != x->array.rank)
                                goto ERROR;
                        for (i = 0;  i < x->array.rank;  i++)
                                if (r->array.dims[i] != x->array.dims[i])
                                        goto ERROR;
                        i = (r->vector.self.bit - xp)*8 + (r->vector.offset - xo);
                        if ((i > 0 && i < d) || (i < 0 && -i < d)) {
                                r0 = r;
                                r = ECL_NIL;
                                replace = TRUE;
                                goto L2;
                        } 
                        i = (r->vector.self.bit - yp)*8 + (r->vector.offset - yo);
                        if ((i > 0 && i < d) || (i < 0 && -i < d)) {
                                r0 = r;
                                r = ECL_NIL;
                                replace = TRUE;
                        }
                }
        L2:
                if (Null(r)) {
                  r = ecl_alloc_object(t_array);
                  r->array.self.t = NULL;
                  r->array.displaced = ECL_NIL;
                  r->array.rank = x->array.rank;
                  r->array.dims = x->array.dims;
                  r->array.elttype = ecl_aet_bit;
                  r->array.dim = x->array.dim;
                  r->array.flags = 0; /* no fill pointer, not adjustable */
                  ecl_array_allocself(r);
                }
        }
        rp = r->vector.self.bit;
        ro = r->vector.offset;
        op = fixnum_operations[coerce_to_logical_operator(o)];

#define set_high(place, nbits, value) \
        (place)=((place)&~(-0400>>(nbits)))|((value)&(-0400>>(nbits)))

#define set_low(place, nbits, value) \
        (place)=((place)&(-0400>>(8-(nbits))))|((value)&~(-0400>>(8-(nbits))))

#define extract_byte(integer, pointer, index, offset) \
        (integer) = (pointer)[(index)+1] & 0377; \
        (integer) = ((pointer)[index]<<(offset))|((integer)>>(8-(offset)))

#define store_byte(pointer, index, offset, value) \
        set_low((pointer)[index], 8-(offset), (value)>>(offset)); \
        set_high((pointer)[(index)+1], offset, (value)<<(8-(offset)))

        if (xo == 0 && yo == 0 && ro == 0) {
                for (n = d/8, i = 0;  i < n;  i++)
                        rp[i] = (*op)(xp[i], yp[i]);
                if ((j = d%8) > 0)
                        set_high(rp[n], j, (*op)(xp[n], yp[n]));
                if (!replace)
                        @(return r)
        } else {
                for (n = d/8, i = 0;  i <= n;  i++) {
                        extract_byte(xi, xp, i, xo);
                        extract_byte(yi, yp, i, yo);
                        if (i == n) {
                                if ((j = d%8) == 0)
                                        break;
                                extract_byte(ri, rp, n, ro);
                                set_high(ri, j, (*op)(xi, yi));
                        } else
                                ri = (*op)(xi, yi);
                        store_byte(rp, i, ro, ri);
                }
                if (!replace)
                        @(return r)
        }
        rp = r0->vector.self.bit;
        ro = r0->vector.offset;
        for (n = d/8, i = 0;  i <= n;  i++) {
                if (i == n) {
                        if ((j = d%8) == 0)
                                break;
                        extract_byte(ri, rp, n, ro);
                        set_high(ri, j, r->vector.self.bit[n]);
                } else
                        ri = r->vector.self.bit[i];
                store_byte(rp, i, ro, ri);
        }
        @(return r0)
ERROR:
        FEerror("Illegal arguments for bit-array operation.", 0);
}
