From 102fe7a6693f1aa8282890b25d634079ddc86e13 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 3 Jan 2011 02:45:16 +0000 Subject: * interp/g-util.boot: Expand new bit vector operators. * interp/g-opt.boot (opt2bit): New. (opt2bool): Likewise. * interp/bits.lisp (BVEC-SIZE): Remove. (BVEC-COPY): Likewise. (BVEC-CONCAT): Likewise. (BVEC-EQUAL): Likewise. (BVEC-AND): Likewise. (BVEC-OR): Likewise. (BVEC-XOR): Likewise. (BVEC-NAND): Likewise. (BVEC-NOR): Likewise. (BVEC-NOT): Likewise. * algebra/boolean.spad.pamphlet (IndexedBits): Remove uses of Lisp-level functions. --- src/interp/bits.lisp | 12 +----------- src/interp/g-opt.boot | 21 ++++++++++++++++++-- src/interp/g-util.boot | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/interp/types.boot | 6 ++++++ 4 files changed, 78 insertions(+), 13 deletions(-) (limited to 'src/interp') diff --git a/src/interp/bits.lisp b/src/interp/bits.lisp index 4ae37adf..5b20b3e7 100644 --- a/src/interp/bits.lisp +++ b/src/interp/bits.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2011, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -55,20 +55,10 @@ (defmacro bvec-elt (bv i) `(sbit ,bv ,i)) (defmacro bvec-setelt (bv i x) `(setf (sbit ,bv ,i) ,x)) -(defmacro bvec-size (bv) `(size ,bv)) -(defun bvec-copy (bv) (copy-seq bv)) -(defun bvec-concat (bv1 bv2) (concatenate '(vector bit) bv1 bv2)) -(defun bvec-equal (bv1 bv2) (equal bv1 bv2)) (defun bvec-greater (bv1 bv2) (let ((pos (mismatch bv1 bv2))) (cond ((or (null pos) (>= pos (length bv1))) nil) ((< pos (length bv2)) (> (bit bv1 pos) (bit bv2 pos))) ((find 1 bv1 :start pos) t) (t nil)))) -(defun bvec-and (bv1 bv2) (bit-and bv1 bv2)) -(defun bvec-or (bv1 bv2) (bit-ior bv1 bv2)) -(defun bvec-xor (bv1 bv2) (bit-xor bv1 bv2)) -(defun bvec-nand (bv1 bv2) (bit-nand bv1 bv2)) -(defun bvec-nor (bv1 bv2) (bit-nor bv1 bv2)) -(defun bvec-not (bv) (bit-not bv)) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 8bed62d1..827a750a 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -453,13 +453,16 @@ $VMsideEffectFreeOperators == %lreverse %lempty? %hash %ismall? %string? %f2s %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %cup %cdown %sname %strlength %streq %i2s %schar %strlt %strconc %strcopy %strstc - %vref %vlength %before?) + %vref %vlength + %bitvecnot %bitvecand %bitvecnand %bivecor %bitvecnor %bitvecxor + %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq + %before?) ++ List of simple VM operators $simpleVMoperators == append($VMsideEffectFreeOperators, ['CONS,'LIST,'VECTOR,'STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!, - '%strstc,"MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"]) + '%strstc,'%makebitvec,"MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"]) ++ Return true if the `form' is semi-simple with respect to ++ to the list of operators `ops'. @@ -749,6 +752,18 @@ optIquo(x is ['%iquo,a,b]) == integer? a and integer? b => a quo b x +-- Boolean <-> bit conversion. +opt2bit(x is ['%2bit,a]) == + a is '%true => 1 + a is '%false => 0 + x + +opt2bool(x is ['%2bool,a]) == + integer? a => + a = 1 => '%true + '%false + x + --% --% optimizer hash table --% @@ -776,6 +791,8 @@ for x in '( (%call optCall) _ (%irem optIrem)_ (%iquo optIquo)_ (%imul optImul)_ + (%2bit opt2bit)_ + (%2bool opt2bool)_ (LIST optLIST)_ (QSMINUS optQSMINUS)_ (SPADCALL optSPADCALL)_ diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index fb98bc83..197da15a 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -366,6 +366,45 @@ expandStrlt ['%strlt,x,y] == expandStrstc ['%strstc,x,y,z] == expandToVMForm ['%store,['%schar,x,y],z] +-- bit vector operations +expandBitvecnot ['%bitvecnot,x] == + ['BIT_-NOT,expandToVMForm x] + +expandBitvecand ['%bitvecand,x,y] == + ['BIT_-AND,expandToVMForm x,expandToVMForm y] + +expandBitvecnand ['%bitvecnand,x,y] == + ['BIT_-NAND,expandToVMForm x,expandToVMForm y] + +expandBitvecor ['%bitvecor,x,y] == + ['BIT_-IOR,expandToVMForm x,expandToVMForm y] + +expandBitvecnor ['%bitvecnor,x,y] == + ['BIT_-NOR,expandToVMForm x,expandToVMForm y] + +expandBitvecxor ['%bitvecxor,x,y] == + ['BIT_-XOR,expandToVMForm x,expandToVMForm y] + +expandBitveclength ['%bitveclength,x] == + ['LENGTH,expandToVMForm x] + +expandBitveccopy ['%bitveccopy,x] == + ['COPY_-SEQ,expandToVMForm x] + +expandBitvecconc ['%bitvecconc,x,y] == + ['CONCATENATE, quoteForm '%BitVector,expandToVMForm x,expandToVMForm y] + +expandBitvecref ['%bitvecref,x,y] == + ['SBIT,expandToVMForm x,expandToVMForm y] + +expandBitveceq ['%bitveceq,x,y] == + ['EQUAL,expandToVMForm x,expandToVMForm y] + +expandMakebitvec ['%makebitvec,x,y] == + ['MAKE_-ARRAY,['LIST,expandToVMForm x], + KEYWORD::ELEMENT_-TYPE,quoteForm '%Bit, + KEYWORD::INITIAL_-ELEMENT,expandToVMForm y] + -- Local variable bindings expandBind ['%bind,inits,:body] == body := expandToVMForm body @@ -583,6 +622,19 @@ for x in [ ['%strlt, :function expandStrlt], ['%strstc, :function expandStrstc], + ['%bitvecnot, :function expandBitvecnot], + ['%bitvecand, :function expandBitvecand], + ['%bitvecnand, :function expandBitvecnand], + ['%bitvecor, :function expandBitvecor], + ['%bitvecxor, :function expandBitvecxor], + ['%bitvecnor, :function expandBitvecnor], + ['%bitveclength, :function expandBitveclength], + ['%bitveccopy, :function expandBitveccopy], + ['%bitvecconc, :function expandBitvecconc], + ['%bitveceq, :function expandBitveceq], + ['%bitvecref, :function expandBitvecref], + ['%makebitvec, :function expandMakebitvec], + ['%peq, :function expandPeq], ['%before?, :function expandBefore?], diff --git a/src/interp/types.boot b/src/interp/types.boot index 60139497..6022a5cb 100644 --- a/src/interp/types.boot +++ b/src/interp/types.boot @@ -52,6 +52,10 @@ namespace BOOT %Boolean <=> BOOLEAN +++ Type of a bit value. +%Bit <=> + BIT + ++ Type of 8-bit sized unsigned integer values. %Byte <=> UNSIGNED_-BYTE 8 @@ -115,6 +119,8 @@ namespace BOOT %Vector a <=> VECTOR a +%BitVector <=> %Vector %Bit + %Thing <=> true %Sequence <=> SEQUENCE -- cgit v1.2.3