Ignore:
Timestamp:
02/13/05 04:02:56 (16 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/bit-array-ops.lisp

    r8554 r8556  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: bit-array-ops.lisp,v 1.3 2005-02-12 21:11:46 piso Exp $
     4;;; $Id: bit-array-ops.lisp,v 1.4 2005-02-13 04:02:56 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6767;; (def-bit-array-op bit-ior   logior)
    6868;; (def-bit-array-op bit-xor   logxor)
    69 (def-bit-array-op bit-eqv   logeqv)
     69;; (def-bit-array-op bit-eqv   logeqv)
    7070;; (def-bit-array-op bit-nand  lognand)
    71 (def-bit-array-op bit-nor   lognor)
    72 (def-bit-array-op bit-andc1 logandc1)
    73 (def-bit-array-op bit-andc2 logandc2)
    74 (def-bit-array-op bit-orc1  logorc1)
    75 (def-bit-array-op bit-orc2  logorc2)
     71;; (def-bit-array-op bit-nor   lognor)
     72;; (def-bit-array-op bit-andc1 logandc1)
     73;; (def-bit-array-op bit-andc2 logandc2)
     74;; (def-bit-array-op bit-orc1  logorc1)
     75;; (def-bit-array-op bit-orc2  logorc2)
    7676
    7777(defun bit-and (bit-array-1 bit-array-2 &optional result-bit-array)
     
    111111                        (row-major-aref bit-array-2 i)))))))
    112112
     113(defun bit-eqv (bit-array-1 bit-array-2 &optional result-bit-array)
     114  (require-same-dimensions bit-array-1 bit-array-2)
     115  (let ((result-bit-array (pick-result-array result-bit-array bit-array-1)))
     116    (if (and (simple-bit-vector-p bit-array-1)
     117             (simple-bit-vector-p bit-array-2)
     118             (simple-bit-vector-p result-bit-array))
     119        (%simple-bit-vector-bit-eqv bit-array-1 bit-array-2 result-bit-array)
     120        (dotimes (i (array-total-size result-bit-array) result-bit-array)
     121          (setf (row-major-aref result-bit-array i)
     122                (logand (logeqv (row-major-aref bit-array-1 i)
     123                                (row-major-aref bit-array-2 i))
     124                        1))))))
     125
    113126(defun bit-nand (bit-array-1 bit-array-2 &optional result-bit-array)
    114127  (require-same-dimensions bit-array-1 bit-array-2)
     
    121134          (setf (row-major-aref result-bit-array i)
    122135                (logand (lognand (row-major-aref bit-array-1 i)
     136                                 (row-major-aref bit-array-2 i))
     137                        1))))))
     138
     139(defun bit-nor (bit-array-1 bit-array-2 &optional result-bit-array)
     140  (require-same-dimensions bit-array-1 bit-array-2)
     141  (let ((result-bit-array (pick-result-array result-bit-array bit-array-1)))
     142    (if (and (simple-bit-vector-p bit-array-1)
     143             (simple-bit-vector-p bit-array-2)
     144             (simple-bit-vector-p result-bit-array))
     145        (%simple-bit-vector-bit-nor bit-array-1 bit-array-2 result-bit-array)
     146        (dotimes (i (array-total-size result-bit-array) result-bit-array)
     147          (setf (row-major-aref result-bit-array i)
     148                (logand (lognor (row-major-aref bit-array-1 i)
     149                                (row-major-aref bit-array-2 i))
     150                        1))))))
     151
     152(defun bit-andc1 (bit-array-1 bit-array-2 &optional result-bit-array)
     153  (require-same-dimensions bit-array-1 bit-array-2)
     154  (let ((result-bit-array (pick-result-array result-bit-array bit-array-1)))
     155    (if (and (simple-bit-vector-p bit-array-1)
     156             (simple-bit-vector-p bit-array-2)
     157             (simple-bit-vector-p result-bit-array))
     158        (%simple-bit-vector-bit-andc1 bit-array-1 bit-array-2 result-bit-array)
     159        (dotimes (i (array-total-size result-bit-array) result-bit-array)
     160          (setf (row-major-aref result-bit-array i)
     161                (logand (logandc1 (row-major-aref bit-array-1 i)
     162                                  (row-major-aref bit-array-2 i))
     163                        1))))))
     164
     165(defun bit-andc2 (bit-array-1 bit-array-2 &optional result-bit-array)
     166  (require-same-dimensions bit-array-1 bit-array-2)
     167  (let ((result-bit-array (pick-result-array result-bit-array bit-array-1)))
     168    (if (and (simple-bit-vector-p bit-array-1)
     169             (simple-bit-vector-p bit-array-2)
     170             (simple-bit-vector-p result-bit-array))
     171        (%simple-bit-vector-bit-andc2 bit-array-1 bit-array-2 result-bit-array)
     172        (dotimes (i (array-total-size result-bit-array) result-bit-array)
     173          (setf (row-major-aref result-bit-array i)
     174                (logand (logandc2 (row-major-aref bit-array-1 i)
     175                                  (row-major-aref bit-array-2 i))
     176                        1))))))
     177
     178(defun bit-orc1 (bit-array-1 bit-array-2 &optional result-bit-array)
     179  (require-same-dimensions bit-array-1 bit-array-2)
     180  (let ((result-bit-array (pick-result-array result-bit-array bit-array-1)))
     181    (if (and (simple-bit-vector-p bit-array-1)
     182             (simple-bit-vector-p bit-array-2)
     183             (simple-bit-vector-p result-bit-array))
     184        (%simple-bit-vector-bit-orc1 bit-array-1 bit-array-2 result-bit-array)
     185        (dotimes (i (array-total-size result-bit-array) result-bit-array)
     186          (setf (row-major-aref result-bit-array i)
     187                (logand (logorc1 (row-major-aref bit-array-1 i)
     188                                 (row-major-aref bit-array-2 i))
     189                        1))))))
     190
     191(defun bit-orc2 (bit-array-1 bit-array-2 &optional result-bit-array)
     192  (require-same-dimensions bit-array-1 bit-array-2)
     193  (let ((result-bit-array (pick-result-array result-bit-array bit-array-1)))
     194    (if (and (simple-bit-vector-p bit-array-1)
     195             (simple-bit-vector-p bit-array-2)
     196             (simple-bit-vector-p result-bit-array))
     197        (%simple-bit-vector-bit-orc2 bit-array-1 bit-array-2 result-bit-array)
     198        (dotimes (i (array-total-size result-bit-array) result-bit-array)
     199          (setf (row-major-aref result-bit-array i)
     200                (logand (logorc2 (row-major-aref bit-array-1 i)
    123201                                 (row-major-aref bit-array-2 i))
    124202                        1))))))
Note: See TracChangeset for help on using the changeset viewer.