;;; Lisplab, integer-store-functions.lisp ;;; Level2, functions and operations for integer stores ;;; Copyright (C) 2012 Joern Inge Vestgaarden ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License along ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. (in-package :lisplab) (defmacro defun-umat-op (name opname store-type mod-size) (let ((a (gensym)) (out (gensym)) (i (gensym))) `(defun ,name (,a ,out) (declare (type ,store-type ,a ,out)) (dotimes (,i (length ,a)) (setf (aref ,out ,i) (mod (,opname (aref ,a ,i)) ,mod-size))) (values)))) (defun-umat-op ub8-not lognot type-ub8-store #xff) (defmacro defun-umat-umat-fun (name funname store-type mod-size) (let ((a (gensym)) (b (gensym)) (out (gensym)) (i (gensym))) `(defun ,name (,a ,b ,out) (declare (type ,store-type ,a ,b ,out)) (dotimes (,i (length ,a)) (setf (aref ,out ,i) (mod (,funname (aref ,a ,i) (aref ,b ,i)) ,mod-size))) (values)))) (defun-umat-umat-fun ub8-ub8-and logand type-ub8-store #xff) (defun-umat-umat-fun ub8-ub8-nand lognand type-ub8-store #xff) (defun-umat-umat-fun ub8-ub8-or logior type-ub8-store #xff) (defun-umat-umat-fun ub8-ub8-nor lognor type-ub8-store #xff) (defun-umat-umat-fun ub8-ub8-xor logxor type-ub8-store #xff) (defmacro defun-umat-int-fun (name funname store-type elm-type mod-size) (let ((a (gensym)) (b (gensym)) (out (gensym)) (i (gensym))) `(defun ,name (,a ,b ,out) (declare (type integer ,b)) (let ((,b (mod ,b ,mod-size))) (declare (type ,store-type ,a ,out) (type ,elm-type ,b)) (dotimes (,i (length ,a)) (setf (aref ,out ,i) (mod (,funname (aref ,a ,i) ,b) ,mod-size))) (values))))) (defun-umat-int-fun ub8-int-and logand type-ub8-store (unsigned-byte 8) #xff) (defun-umat-int-fun ub8-int-nand lognand type-ub8-store (unsigned-byte 8) #xff) (defun-umat-int-fun ub8-int-or logior type-ub8-store (unsigned-byte 8) #xff) (defun-umat-int-fun ub8-int-nor lognor type-ub8-store (unsigned-byte 8) #xff) (defun-umat-int-fun ub8-int-xor logxor type-ub8-store (unsigned-byte 8) #xff)