Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/array.clisp
There are no other files named array.clisp in the archive.
;;; -*- Lisp -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; Functions to implement arrays for Spice Lisp
;;; Written by Joe Ginder.
;;; Rewritten and currently maintained by Skef Wholey.
;;;
;;; The array functions are part of the standard Spicelisp environment.
;;;
;;; **********************************************************************
;;;
(in-package 'lisp)
(export '(array-rank-limit make-array array-element-type array-rank
array-dimension array-dimensions array-total-size array-in-bounds-p
array-row-major-index adjustable-array-p bit-and bit-ior
bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2 bit-orc1
bit-orc2 bit-not array-has-fill-pointer-p fill-pointer vector-push
vector-push-extend vector-pop adjust-array))
;20; get rid of all %primitive's. We just use them as functions
;20; anything above this will probably blow the stack
(defconstant array-rank-limit 262144
"The maximum number of dimensions an array may have.")
;;; Macros for Make-Array:
(eval-when (compile eval)
(defmacro array-linear-length (dimensions)
`(do ((dimensions ,dimensions (cdr dimensions))
(length 1))
((null dimensions) length)
(declare (fixnum length))
(setq length (* length (the fixnum (car dimensions))))))
;;; Init-Array-Data initializes the data vector of the Array. If the Array
;;; is displaced, its data vector is set to the data vector of the array to
;;; which it is displaced. If initial contents are specified, these are used
;;; to fill the array. If neither of the above conditions are satisfied,
;;; the array is filled with the given initial value (or what it defaults to).
(defmacro init-array-data (array size type rank ival icontents disp-to)
`(header-set ,array %array-data-slot
(cond ((slisp-array-p ,disp-to)
(header-ref ,disp-to %array-data-slot))
((arrayp ,disp-to)
,disp-to)
(,icontents
(copy-initial-contents ,size ,type ,rank ,icontents))
((eq ,type 'bit)
(U-data-vec ,size '(mod 2) ,ival))
((and (listp ,type) (eq (car ,type) 'mod))
(U-data-vec ,size ,type ,ival))
(t
(B-data-vec ,size ,type ,ival)))))
)
(defun make-array (dimensions &key
(element-type t)
(initial-element '%%default)
(initial-contents)
(adjustable ())
(fill-pointer ())
(displaced-to ())
(displaced-index-offset 0))
"Returns a newly constructed array with the dimensions and options
specified. See manual for details."
(if (not (listp dimensions)) (setq dimensions (list dimensions)))
(if (eq fill-pointer t) (setq fill-pointer (car dimensions)))
(let ((array-rank (length (the list dimensions))))
(declare (fixnum array-rank))
(if (and (not adjustable) (= array-rank 1)
(not displaced-to) (not fill-pointer))
(if initial-contents
(copy-initial-contents (car dimensions) element-type
1 initial-contents)
(cond
((eq element-type 'bit)
(U-data-vec (car dimensions) '(mod 2) initial-element))
((and (listp element-type) (eq (car element-type) 'mod))
(U-data-vec (car dimensions) element-type initial-element))
(t
(B-data-vec (car dimensions) element-type initial-element))))
(let ((array-size (array-linear-length dimensions))
(array (%sp-alloc-array array-rank)))
(init-array-data array array-size element-type array-rank
initial-element initial-contents displaced-to)
(header-set array %array-length-slot array-size)
(header-set array %array-fill-pointer-slot
(if fill-pointer fill-pointer array-size))
(header-set array %array-displacement-slot
(cond ((not (arrayp displaced-to)) 0)
((integerp displaced-index-offset)
displaced-index-offset)
(T 0)))
(do ((dimensions dimensions (cdr dimensions))
(index %array-first-dim-slot (1+ index)))
((null dimensions))
(declare (fixnum index))
(header-set array index (car dimensions)))
array))))
;;; Make-vector is no longer in the language, use Make-array. To make sure
;;; set things so that they get make-array if trying to call make-vector.
(setf (symbol-function 'make-vector) #'make-array)
(%put (quote lisp::make-vector) (quote lisp::%fun-documentation)
(quote "Make-vector is obsolete. Use Make-array."))
;(defun make-vector (length &key
; (element-type t)
; (initial-element '%%default)
; (initial-contents))
; "Like Make-Array, but returns a simple vector always."
; (cond (initial-contents
; (copy-initial-contents length element-type 1 initial-contents))
; ((eq element-type 'bit)
; (U-data-vec length '(mod 2) initial-element))
; ((and (listp element-type) (eq (car element-type) 'mod))
; (U-data-vec length element-type initial-element))
; (t
; (B-data-vec length element-type initial-element))))
;20; vector is in the kernel
;;; U-Data-Vec returns a data vector of unboxed objects initialized to Ival.
(defun U-data-vec (size type ival)
(declare (fixnum size ival))
(let* ((access-code (let ((n (cadr type)))
(declare (fixnum n))
(cond
((<= n 2) 0)
((<= n 4) 1)
((<= n 16) 2)
((<= n 256) 3)
((<= n 65536) 4)
(t (error "~S is too big a modulo type." type)))))
(data-vec (%sp-alloc-u-vector size access-code)))
(declare (fixnum access-code))
(if (and (not (eq ival '%%default)) (< ival (the fixnum (cadr type))))
(do ((index 0 (1+ index)))
((= index size) data-vec)
(declare (fixnum index))
(%sp-saset1 data-vec index ival))
data-vec)))
;;; B-Data-Vec returns a data vector of boxed objects initialized to Ival.
(defun b-data-vec (size type ival)
(if (eq type 'string-char)
(if (eq ival '%%default)
(%sp-alloc-string size)
(make-string size :initial-element ival))
(%sp-alloc-b-vector
size
(case type
((t) (if (eq ival '%%default) nil ival))
((random list cons function closure)
(if (typep ival type) ival ()))
((fixnum bignum integer rational scalar)
(if (typep ival type) ival
(error "The initial-element, ~s, is not of type ~s" ival type)))
((float short-float long-float single-float double-float)
(if (typep ival type) ival (coerce 0 type)))
(character (if (characterp ival) ival #\space))
(string (if (stringp ival) ival ""))
(symbol (if (and (symbolp ival) (not (eq ival '%%default)))
ival
NIL))
(vector (if (vectorp ival) ival '#()))
(array (if (arrayp ival) ival '#()))
(complex (error "Complex numbers aren't implemented yet."))
(T (if (typep ival type) ival ()))))))
;;; Copy-Initial-Contents returns a data vector formed by copying the sequences
;;; in the initial contents, Icontents. We allocate a data vector using one
;;; of the above functions, and then spin off to an auxiliary function to
;;; recursively copy the initial contents into the data vector.
(defun copy-initial-contents (size type rank icontents)
(let ((data (cond
((eq type 'bit)
(u-data-vec size '(mod 2) '%%default))
((and (listp type) (eq (car type) 'mod))
(u-data-vec size type '%%default))
(t
(b-data-vec size type nil)))))
(copy-contents-aux icontents type rank 0 data)
data))
(defun copy-contents-aux (icontents type depth index data)
(cond ((= depth 0)
(if (typep icontents type)
(%sp-saset1 data index icontents)
(error "~S is not if type ~S, and can't be used as contents."
icontents type))
(1+ index))
((listp icontents)
(do ((icontents icontents (cdr icontents)))
((null icontents) index)
(setq index (copy-contents-aux
(car icontents) type (1- depth) index data))))
((vectorp icontents)
(do ((i-index 0 (1+ i-index))
(i-end (length icontents)))
((= i-index i-end) index)
(setq index (copy-contents-aux
(aref icontents index) type (1- depth) index data))))
(t
(error "~S is a bad thing to initialize array contents with."
icontents))))
;;; A helpful macro:
(eval-when (compile eval)
(defmacro linearize-subscripts (array subscripts)
`(do ((subscripts (nreverse (the list ,subscripts)) (cdr subscripts))
(dim-index (1- (header-length array)) (1- dim-index))
(chunk-size 1)
(result 0)
(axis))
((= dim-index %array-dim-base)
(if (atom subscripts)
(+ (the fixnum (header-ref ,array %array-displacement-slot))
result)
(error "Too many subscripts for array reference.")))
(declare (fixnum dim-index chunk-size result axis))
(setq axis (header-ref ,array dim-index))
(cond ((atom subscripts)
(error "Too few subscripts for array reference."))
((not (< -1 (the fixnum (car subscripts)) axis))
(error "Subscript (~S) is out of bounds." (car subscripts)))
(t
(setq result (+ result (* (the fixnum (car subscripts))
chunk-size)))
(setq chunk-size (* chunk-size axis))))))
(defmacro linearize-subscripts* (subscripts dim-list)
`(do ((subscripts ,subscripts (cdr subscripts))
(dim-list ,dim-list (cdr dim-list))
(chunk-size 1)
(result 0))
((null dim-list) result)
(declare (fixnum chunk-size result))
(setq result (+ result (* (the fixnum (car subscripts)) chunk-size)))
(setq chunk-size (* chunk-size (car dim-list)))))
)
;;; Array Accessing functions
;20; aref is in kernel. %sp-aref handles non-simple arrays only
(defun %sp-aref (array &rest subscripts)
"Returns the element of the Array specified by the Subscripts."
(%sp-saref1 (header-ref array %array-data-slot)
(linearize-subscripts array subscripts)))))
;20; aset is in kernel. %sp-aset handles non-simple arrays only
(defun %sp-aset (array &rest stuff)
(let ((rstuff (nreverse (the list stuff))))
(do ((subscripts (cdr rstuff) (cdr subscripts))
(dim-index (1- (header-length array)) (1- dim-index))
(chunk-size 1)
(result 0)
(axis))
((= dim-index %array-dim-base)
(if (atom subscripts)
(aset1 (header-ref array %array-data-slot)
(+ (the fixnum
(header-ref
array %array-displacement-slot))
result)
(car rstuff))
(error "Too many subscripts for array reference.")))
(declare (fixnum dim-index chunk-size result axis))
(setq axis (header-ref array dim-index))
(cond ((atom subscripts)
(error "Too few subscripts for array reference."))
((not (< -1 (the fixnum (car subscripts)) axis))
(error "Subscript (~S) is out of bounds."
(car subscripts)))
(t
(setq result (+ result (* (the fixnum (car subscripts))
chunk-size)))
(setq chunk-size (* chunk-size axis)))))))))))
;20; svref and %svset are in the kernel
;;; Array Information functions
(eval-when (compile eval)
(defmacro internal-array-length (array)
`(header-ref ,array %array-length-slot))
)
(defun array-element-type (array)
"Returns the type of the elements of the array"
(cond ((bit-vector-p array)
'(mod 2))
((stringp array)
'string-char)
((simple-vector-p array)
t)
((slisp-array-p array)
(array-element-type (header-ref array %array-data-slot)))
((vectorp array)
(case (%sp-get-vector-access-type array)
(0 '(mod 2))
(1 '(mod 4))
(2 '(mod 16))
(3 '(mod 256))
(4 '(mod 65536))))
(t (error "~S is not an array." array))))
(defun array-rank (array)
"Returns the number of dimensions of the Array."
(if (slisp-array-p array)
(- (header-length array) %array-first-dim-slot)
1))
(defun array-dimension (array axis-number)
(declare (fixnum axis-number))
"Returns length of dimension Axis-Number of the Array."
(if (slisp-array-p array)
(if (and (>= axis-number 0) (< axis-number (array-rank array)))
(header-ref array (+ %array-first-dim-slot axis-number))
(error "~S: Illegal axis number." axis-number))
(if (= axis-number 0)
(%sp-get-vector-length array)
(error "~S: Illegal axis number." axis-number))))
(defun array-dimensions (array)
"Returns a list whose elements are the dimensions of the array"
(if (slisp-array-p array)
(do ((index %array-first-dim-slot (1+ index))
(end (header-length array))
(result ()))
((= index end) (nreverse result))
(declare (list result))
(push (header-ref array index) result))
(list (%sp-get-vector-length array))))
(defun array-total-size (array)
"Returns the total number of elements in the Array."
(if (slisp-array-p array)
(header-ref array %array-length-slot)
(%sp-get-vector-length array)))
(defun array-in-bounds-p (array &rest subscripts)
"Returns T if the Subscipts are in bounds for the Array, Nil otherwise."
(if (slisp-array-p array)
(do ((dim-index %array-first-dim-slot (1+ dim-index))
(dim-index-limit (+ %array-first-dim-slot
(the fixnum (array-rank array))))
(subs subscripts (cdr subs)))
((= dim-index dim-index-limit)
(if (atom subs) T ()))
(declare (fixnum dim-index dim-index-limit))
(if (atom subs)
(return ())
(let ((subscript (car subs))
(dimension (header-ref array dim-index)))
(declare (fixnum subscript dimension))
(if (not (< -1 subscript dimension))
(return ()) ))))
(and (null (cdr subscripts))
(< -1 (the fixnum (car subscripts))
(%sp-get-vector-length array)))))
(defun array-row-major-index (array &rest subscripts)
"Returns the index into the Array's data vector for the given subscripts."
(if (slisp-array-p array)
(do ((subscripts (nreverse (the list subscripts)) (cdr subscripts))
(dim-index (1- (header-length array)) (1- dim-index))
(chunk-size 1)
(result 0)
(axis))
((= dim-index %array-dim-base)
(if (atom subscripts)
result
(error "Too many subscripts for array reference.")))
(setq axis (header-ref array dim-index))
(cond ((atom subscripts)
(error "Too few subscripts for array reference."))
((not (< -1 (car subscripts) axis))
(error "Subscript ~S is out of bounds." (car subscripts)))
(t
(setq result (+ result (* (car subscripts) chunk-size)))
(setq chunk-size (* chunk-size axis)))))
(cond ((> (length subscripts) 1)
(error "Too many subscripts for array reference."))
((null subscripts)
(error "Too few subscripts for array reference."))
((or (> (car subscripts) (1- (length array)))
(minusp (car subscripts)))
(error "Subscript ~S is out of bounds." (car subscripts)))
(t
(car subscripts))))) ; for 1-d array, result equals subscript
(defun adjustable-array-p (array)
"Returns T if the given Array is adjustable, or Nil otherwise."
(slisp-array-p array))
;;; Array fill pointer functions
(defun array-has-fill-pointer-p (array)
"Returns T if the given Array has a fill pointer, or Nil otherwise."
(and (vectorp array) (slisp-array-p array)))
(defun fill-pointer (vector)
"Returns the fill pointer of the Vector."
(if (and (vectorp vector) (slisp-array-p vector))
(header-ref vector %array-fill-pointer-slot)
(error "~S is not an array with a fill pointer." vector)))
(defun %set-fill-pointer (vector index)
"Sets the fill pointer of the given Vector to Index."
(if (and (vectorp vector) (slisp-array-p vector))
(if (> index (header-ref vector %array-length-slot))
(error "New fill pointer, ~S, is larger than the length of array."
index)
(header-set vector %array-fill-pointer-slot index))
(error "~S is not an array with a fill pointer." vector)))
(defun vector-push (new-el array)
"Attempts to set the element of Array designated by the fill pointer
to New-El and increment fill pointer by one. If the fill pointer is
too large, () is returned, otherwise the new fill pointer value is
returned."
(if (slisp-array-p array)
(let ((fill-pointer (header-ref array %array-fill-pointer-slot)))
(declare (fixnum fill-pointer))
(cond ((= fill-pointer (internal-array-length array)) ())
(t (header-set array %array-fill-pointer-slot (1+ fill-pointer))
(%sp-saset1 (header-ref array %array-data-slot)
(+ fill-pointer
(header-ref array %array-displacement-slot))
new-el)
(1+ fill-pointer))))
(error "~S: Object has no fill pointer." array)))
(defun vector-push-extend
(new-el array &optional (extension (max 10 (min 1000 (length array)))))
(declare (fixnum extension))
"Like Vector-Push except that if the fill pointer gets too large, the
Array is extended rather than () being returned."
(if (slisp-array-p array)
(let ((length (internal-array-length array))
(fill-pointer (header-ref array %array-fill-pointer-slot))
(data (header-ref array %array-data-slot)))
(declare (fixnum length fill-pointer))
(if (= fill-pointer length)
(do* ((new-index 0 (1+ new-index))
(new-length (+ length extension))
(old-index (header-ref array %array-displacement-slot)
(1+ old-index))
(new-data (make-array new-length
:element-type (array-element-type array))))
((= new-index length)
(header-set array %array-data-slot new-data)
(setq data new-data)
(header-set array %array-length-slot new-length)
(header-set array %array-first-dim-slot new-length))
(%sp-saset1 new-data new-index (%sp-saref1 data old-index))))
(header-set array %array-fill-pointer-slot (1+ fill-pointer))
(%sp-saset1 data
(+ fill-pointer
(header-ref array %array-displacement-slot))
new-el)
(1+ fill-pointer))
(error "~S has no fill pointer." array)))
(defun vector-pop (array)
"Attempts to decrease the fill-pointer by 1 and return the element
pointer to by the new fill pointer. If the new value of the fill
pointer is 0, an error occurs."
(if (slisp-array-p array)
(let ((fill-pointer (header-ref array %array-fill-pointer-slot)))
(declare (fixnum fill-pointer))
(cond ((< fill-pointer 1) (error "Fill-pointer reached 0."))
(t (header-set array %array-fill-pointer-slot (1- fill-pointer))
(%sp-saref1 (header-ref array %array-data-slot)
(+ (1- fill-pointer)
(header-ref
array %array-displacement-slot))))))
(error "~S: Object has no fill pointer." array)))
;;; Changing the size of an array:
(defun shrink-vector (vector new-size)
"Destructively alters the Vector, changing its length to New-Size, which
must be less than or equal to its current size."
(cond ((slisp-array-p vector)
(%sp-shrink-vector (header-ref vector %array-data-slot) new-size)
(header-set vector %array-length-slot new-size))
(t
(%sp-shrink-vector vector new-size))))
(defun adjust-array (array dimensions &rest options &key
(element-type t)
(initial-element '%%default)
(initial-contents)
(fill-pointer ())
(displaced-to ())
(displaced-index-offset 0))
"Adjusts the Array's dimensions to the given Dimensions. See manual
for details."
(declare (ignore displaced-index-offset))
(if (atom dimensions) (setq dimensions (list dimensions)))
(if (not (= (%sp-type array) %array-type))
(error "~S is not an adjustable array." array))
(if (not (= (length (the list dimensions)) (array-rank array)))
(error "Number of dimensions not equal to rank of array."))
(if (and element-type
(not (subtypep element-type (array-element-type array))))
(error "New element type, ~S, is incompatible with old." element-type))
(cond ((or initial-contents displaced-to)
(apply #'make-array dimensions options))
((null (cdr dimensions))
(if (eq fill-pointer t) (setq fill-pointer (car dimensions)))
(if fill-pointer
(header-set array %array-fill-pointer-slot fill-pointer))
(let ((old-length (header-ref array %array-length-slot))
(new-length (car dimensions))
(old-data (header-ref array %array-data-slot)))
(declare (simple-vector old-data))
(header-set array %array-length-slot new-length)
(cond ((> old-length new-length)
(%sp-shrink-vector old-data new-length))
((< old-length new-length)
(let* ((element-type (or element-type
(array-element-type array)))
(data (cond
((eq element-type 'bit)
(u-data-vec new-length '(mod 2)
initial-element))
((and (listp element-type)
(eq (car element-type) 'mod))
(u-data-vec new-length element-type
initial-element))
(t
(b-data-vec new-length element-type
initial-element)))))
(replace data old-data)
(header-set array %array-data-slot data))))
(header-set array %array-first-dim-slot new-length)))
(t
(if fill-pointer
(error "Multidimensional arrays can't have fill pointers."))
(let* ((old-length (header-ref array %array-length-slot))
(new-length (array-linear-length dimensions))
(old-data (header-ref array %array-data-slot))
(new-data (if (> new-length old-length)
(cond
((eq element-type 'bit)
(u-data-vec new-length '(mod 2)
initial-element))
((and (listp element-type)
(eq (car element-type) 'mod))
(u-data-vec new-length element-type
initial-element))
(t
(b-data-vec new-length element-type
initial-element)))
old-data)))
(header-set array %array-length-slot new-length)
(header-set array %array-data-slot new-data)
(zap-array-data old-data (array-dimensions array)
new-data dimensions)
(do ((new-dims dimensions (cdr new-dims))
(dim-slot %array-first-dim-slot (1+ dim-slot)))
((null new-dims))
(header-set array dim-slot (car new-dims))))))
array)
;;; Zap-Array-Data does the grinding work for Adjust-Array. The data is zapped
;;; from the Old-Data in an arrangement specified by the Old-Dims to the
;;; New-Data in an arrangement specified by the New-Dims.
;;; Bump-Index-List helps us out:
(eval-when (compile eval)
(defmacro bump-index-list (index limits)
`(do ((subscripts ,index (cdr subscripts))
(limits ,limits (cdr limits)))
((null subscripts) nil)
(cond ((< (car subscripts) (car limits))
(rplaca subscripts (1+ (car subscripts)))
(return ,index))
(t
(rplaca subscripts 0)))))
)
(defun zap-array-data (old-data old-dims new-data new-dims)
(declare (list old-dims new-dims))
(setq old-dims (nreverse old-dims))
(setq new-dims (reverse new-dims))
(let ((limits (mapcar #'(lambda (x y)
(1- (min x y)))
old-dims new-dims)))
(do ((index (make-list (length old-dims) :initial-element 0)
(bump-index-list index limits)))
((null index))
(%sp-saset1 new-data (linearize-subscripts* index new-dims)
(%sp-saref1 old-data
(linearize-subscripts* index old-dims))))))
;;; Bit string hacking functions:
;20; bit and bit set functions are in the kernel
(defun bit-array-same-dimensions-p (array1 array2)
(and (= (header-length array1)
(header-length array2))
(do ((index %array-first-dim-slot (1+ index))
(length (- (header-length array1) %array-dim-base)))
((= index length) t)
(if (/= (header-ref array1 index)
(header-ref array2 index))
(return nil)))))
(defmacro bit-bash (array1 array2 result-array op length)
`(do ((index 0 (1+ index)))
((= index ,length) ,result-array)
(%sp-sbitset ,result-array index
(boole ,op (%sp-sbit ,array1 index)
(%sp-sbit ,array2 index)))))
(defun bit-array-boole (array1 array2 op result-array)
(if (eq result-array t) (setq result-array array1))
(cond ((simple-bit-vector-p array1)
(let ((length (%sp-get-vector-length array1)))
(unless (and (simple-bit-vector-p array2)
(= (%sp-get-vector-length array2) length))
(error "~S and ~S do not have the same dimensions."
array1 array2))
(if result-array
(unless (and (simple-bit-vector-p result-array)
(= (%sp-get-vector-length result-array) length))
(error "~S and ~S do not have the same dimensions."
array1 result-array))
(setq result-array (make-array length :element-type '(mod 2))))
(bit-bash array1 array2 result-array op length)))
(t
(unless (bit-array-same-dimensions-p array1 array2)
(error "~S and ~S do not have the same dimensions." array1 array2))
(if result-array
(unless (bit-array-same-dimensions-p array1 result-array)
(error "~S and ~S do not have the same dimensions."
array1 result-array))
(setq result-array (make-array (array-dimensions array1)
:element-type '(mod 2))))
(let ((data1 (header-ref array1 %array-data-slot))
(data2 (header-ref array2 %array-data-slot))
(data3 (header-ref result-array %array-data-slot))
(start1 (header-ref array1 %array-displacement-slot))
(start2 (header-ref array2 %array-displacement-slot))
(start3 (header-ref result-array %array-displacement-slot))
(length (header-ref array1 %array-length-slot)))
(do ((index 0 (1+ index))
(index1 start1 (1+ index1))
(index2 start2 (1+ index2))
(index3 start3 (1+ index3)))
((= index length) result-array)
(%sp-sbitset data3 index3
(boole op (%sp-sbit data1 index1)
(%sp-sbit data2 index2))))))))
(defun bit-and (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical AND on the elements of Bit-Array1 and Bit-Array2
putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-and result-bit-array))
(defun bit-ior (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical IOR on the elements of Bit-Array1 and Bit-Array2
putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-ior result-bit-array))
(defun bit-xor (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical XOR on the elements of Bit-Array1 and Bit-Array2
putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-xor result-bit-array))
(defun bit-eqv (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical EQV on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-eqv result-bit-array))
(defun bit-nand (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical NAND on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-nand result-bit-array))
(defun bit-nor (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical NOR on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-nor result-bit-array))
(defun bit-andc1 (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical ANDC1 on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-andc1 result-bit-array))
(defun bit-andc2 (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical ANDC2 on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-andc2 result-bit-array))
(defun bit-orc1 (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical ORC1 on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-orc1 result-bit-array))
(defun bit-orc2 (bit-array1 bit-array2 &optional result-bit-array)
"Performs a bit-wise logical ORC2 on the elements of Bit-Array1 and
Bit-Array2 putting the results in the Result-Bit-Array."
(bit-array-boole bit-array1 bit-array2 boole-orc2 result-bit-array))
(defun bit-not (bit-array &optional result-bit-array)
"Performs a bit-wise logical NOT in the elements of the Bit-Array putting
the results into the Result-Bit-Array."
(bit-array-boole bit-array bit-array boole-nor result-bit-array))