Changeset 8559
 Timestamp:
 02/13/05 04:13:33 (16 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/j/src/org/armedbear/lisp/bitarrayops.lisp
r8556 r8559 2 2 ;;; 3 3 ;;; Copyright (C) 20032005 Peter Graves 4 ;;; $Id: bitarrayops.lisp,v 1. 4 20050213 04:02:56piso Exp $4 ;;; $Id: bitarrayops.lisp,v 1.5 20050213 04:13:33 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 46 46 (requiresamedimensions bitarray1 resultbitarray) 47 47 resultbitarray))) 48 49 (defmacro defbitarrayop (name function)50 `(defun ,name (bitarray1 bitarray2 &optional resultbitarray)51 ,(format nil52 "Perform a bitwise ~A on the elements of BITARRAY1 and ~53 BITARRAY2,~% putting the results in RESULTBITARRAY. ~54 If RESULTBITARRAY is T,~% BITARRAY1 is used. If ~55 RESULTBITARRAY is NIL or omitted, a new array is~% created. ~56 All the arrays must have the same rank and dimensions."57 (symbolname function))58 (requiresamedimensions bitarray1 bitarray2)59 (let ((resultbitarray (pickresultarray resultbitarray bitarray1)))60 (dotimes (i (arraytotalsize resultbitarray) resultbitarray)61 (setf (rowmajoraref resultbitarray i)62 (logand (,function (rowmajoraref bitarray1 i)63 (rowmajoraref bitarray2 i))64 1))))))65 66 ;; (defbitarrayop bitand logand)67 ;; (defbitarrayop bitior logior)68 ;; (defbitarrayop bitxor logxor)69 ;; (defbitarrayop biteqv logeqv)70 ;; (defbitarrayop bitnand lognand)71 ;; (defbitarrayop bitnor lognor)72 ;; (defbitarrayop bitandc1 logandc1)73 ;; (defbitarrayop bitandc2 logandc2)74 ;; (defbitarrayop bitorc1 logorc1)75 ;; (defbitarrayop bitorc2 logorc2)76 48 77 49 (defun bitand (bitarray1 bitarray2 &optional resultbitarray) … … 203 175 204 176 (defun bitnot (bitarray &optional resultbitarray) 205 "Performs a bitwise logical NOT on the elements of BITARRAY,206 putting the results in RESULTBITARRAY. If RESULTBITARRAY is T,207 BITARRAY is used. If RESULTBITARRAY is NIL or omitted, a new array is208 created. Both arrays must have the same rank and dimensions."209 177 (let ((resultbitarray (pickresultarray resultbitarray bitarray))) 178 (if (and (simplebitvectorp bitarray) 179 (simplebitvectorp resultbitarray)) 180 (%simplebitvectorbitnot bitarray resultbitarray) 210 181 (dotimes (i (arraytotalsize resultbitarray) resultbitarray) 211 182 (setf (rowmajoraref resultbitarray i) 212 (logxor (rowmajoraref bitarray i) 1))))) 183 (logxor (rowmajoraref bitarray i) 1))))))
Note: See TracChangeset
for help on using the changeset viewer.