source: branches/streams/abcl/src/org/armedbear/lisp/SimpleBitVector.java

Last change on this file was 14466, checked in by rschlatte, 12 years ago

call type_error when possible

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 16.2 KB
Line 
1/*
2 * SimpleBitVector.java
3 *
4 * Copyright (C) 2004-2005 Peter Graves
5 * $Id: SimpleBitVector.java 14466 2013-04-24 12:50:40Z rschlatte $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38// "The type of a bit vector that is not displaced to another array, has no
39// fill pointer, and is not expressly adjustable is a subtype of type SIMPLE-
40// BIT-VECTOR."
41public final class SimpleBitVector extends AbstractBitVector
42{
43    public SimpleBitVector(int capacity)
44    {
45        this.capacity = capacity;
46        int size = capacity >>> 6; // 64 bits in a long
47        // If the capacity is not an integral multiple of 64, we'll need one
48        // more long.
49        if ((capacity & LONG_MASK) != 0)
50            ++size;
51        bits = new long[size];
52    }
53
54    public SimpleBitVector(String s)
55    {
56        this(s.length());
57        for (int i = capacity; i-- > 0;) {
58            char c = s.charAt(i);
59            if (c == '0') {
60            } else if (c == '1')
61                setBit(i);
62            else
63                Debug.assertTrue(false);
64        }
65    }
66
67    @Override
68    public LispObject typeOf()
69    {
70        return list(Symbol.SIMPLE_BIT_VECTOR, Fixnum.getInstance(capacity));
71    }
72
73    @Override
74    public LispObject classOf()
75    {
76        return BuiltInClass.SIMPLE_BIT_VECTOR;
77    }
78
79    @Override
80    public LispObject typep(LispObject type)
81    {
82        if (type == Symbol.SIMPLE_BIT_VECTOR)
83            return T;
84        if (type == Symbol.SIMPLE_ARRAY)
85            return T;
86        if (type == BuiltInClass.SIMPLE_BIT_VECTOR)
87            return T;
88        if (type == BuiltInClass.SIMPLE_ARRAY)
89            return T;
90        return super.typep(type);
91    }
92
93    @Override
94    public boolean hasFillPointer()
95    {
96        return false;
97    }
98
99    @Override
100    public boolean isAdjustable()
101    {
102        return false;
103    }
104
105    @Override
106    public boolean isSimpleVector()
107    {
108        return true;
109    }
110
111    @Override
112    public int length()
113    {
114        return capacity;
115    }
116
117    @Override
118    public LispObject elt(int index)
119    {
120        if (index < 0 || index >= length())
121            badIndex(index, length());
122        int offset = index >> 6; // Divide by 64.
123        return (bits[offset] & (1L << (index & LONG_MASK))) != 0 ? Fixnum.ONE : Fixnum.ZERO;
124    }
125
126    @Override
127    public LispObject AREF(int index)
128    {
129        if (index < 0 || index >= capacity)
130            badIndex(index, capacity);
131        int offset = index >> 6;
132        return (bits[offset] & (1L << (index & LONG_MASK))) != 0 ? Fixnum.ONE : Fixnum.ZERO;
133    }
134
135    @Override
136    public void aset(int index, LispObject newValue)
137    {
138        if (index < 0 || index >= capacity)
139            badIndex(index, capacity);
140        final int offset = index >> 6;
141        if (newValue instanceof Fixnum) {
142            switch (((Fixnum)newValue).value) {
143                case 0:
144                    bits[offset] &= ~(1L << (index & LONG_MASK));
145                    return;
146                case 1:
147                    bits[offset] |= 1L << (index & LONG_MASK);
148                    return;
149            }
150        }
151        // Fall through...
152        type_error(newValue, Symbol.BIT);
153    }
154
155    @Override
156    protected int getBit(int index)
157    {
158        int offset = index >> 6;
159        return (bits[offset] & (1L << (index & LONG_MASK))) != 0 ? 1 : 0;
160    }
161
162    @Override
163    protected void setBit(int index)
164    {
165        int offset = index >> 6;
166        bits[offset] |= 1L << (index & LONG_MASK);
167    }
168
169    @Override
170    protected void clearBit(int index)
171    {
172        int offset = index >> 6;
173        bits[offset] &= ~(1L << (index & LONG_MASK));
174    }
175
176    @Override
177    public void shrink(int n)
178    {
179        if (n < capacity) {
180            int size = n >>> 6;
181            if ((n & LONG_MASK) != 0)
182                ++size;
183            if (size < bits.length) {
184                long[] newbits = new long[size];
185                System.arraycopy(bits, 0, newbits, 0, size);
186                bits = newbits;
187            }
188            capacity = n;
189            return;
190        }
191        if (n == capacity)
192            return;
193        error(new LispError());
194    }
195
196    @Override
197    public AbstractVector adjustArray(int newCapacity,
198                                       LispObject initialElement,
199                                       LispObject initialContents)
200
201    {
202        if (initialContents != null) {
203            SimpleBitVector v = new SimpleBitVector(newCapacity);
204            if (initialContents.listp()) {
205                LispObject list = initialContents;
206                for (int i = 0; i < newCapacity; i++) {
207                    v.aset(i, list.car());
208                    list = list.cdr();
209                }
210            } else if (initialContents.vectorp()) {
211                for (int i = 0; i < newCapacity; i++)
212                    v.aset(i, initialContents.elt(i));
213            } else
214                type_error(initialContents, Symbol.SEQUENCE);
215            return v;
216        }
217        if (capacity != newCapacity) {
218            SimpleBitVector v = new SimpleBitVector(newCapacity);
219            final int limit = Math.min(capacity, newCapacity);
220            for (int i = limit; i-- > 0;) {
221                if (getBit(i) == 1)
222                    v.setBit(i);
223                else
224                    v.clearBit(i);
225            }
226            if (initialElement != null && capacity < newCapacity) {
227                int n = Fixnum.getValue(initialElement);
228                if (n == 1)
229                    for (int i = capacity; i < newCapacity; i++)
230                        v.setBit(i);
231                else
232                    for (int i = capacity; i < newCapacity; i++)
233                        v.clearBit(i);
234            }
235            return v;
236        }
237        // No change.
238        return this;
239    }
240
241    @Override
242    public AbstractVector adjustArray(int newCapacity,
243                                       AbstractArray displacedTo,
244                                       int displacement)
245
246    {
247        return new ComplexBitVector(newCapacity, displacedTo, displacement);
248    }
249
250    SimpleBitVector and(SimpleBitVector v, SimpleBitVector result)
251    {
252        if (result == null)
253            result = new SimpleBitVector(capacity);
254        for (int i = bits.length; i-- > 0;)
255            result.bits[i] = bits[i] & v.bits[i];
256        return result;
257    }
258
259    SimpleBitVector ior(SimpleBitVector v, SimpleBitVector result)
260    {
261        if (result == null)
262            result = new SimpleBitVector(capacity);
263        for (int i = bits.length; i-- > 0;)
264            result.bits[i] = bits[i] | v.bits[i];
265        return result;
266    }
267
268    SimpleBitVector xor(SimpleBitVector v, SimpleBitVector result)
269    {
270        if (result == null)
271            result = new SimpleBitVector(capacity);
272        for (int i = bits.length; i-- > 0;)
273            result.bits[i] = bits[i] ^ v.bits[i];
274        return result;
275    }
276
277    SimpleBitVector eqv(SimpleBitVector v, SimpleBitVector result)
278    {
279        if (result == null)
280            result = new SimpleBitVector(capacity);
281        for (int i = bits.length; i-- > 0;)
282            result.bits[i] = ~(bits[i] ^ v.bits[i]);
283        return result;
284    }
285
286    SimpleBitVector nand(SimpleBitVector v, SimpleBitVector result)
287    {
288        if (result == null)
289            result = new SimpleBitVector(capacity);
290        for (int i = bits.length; i-- > 0;)
291            result.bits[i] = ~(bits[i] & v.bits[i]);
292        return result;
293    }
294
295    SimpleBitVector nor(SimpleBitVector v, SimpleBitVector result)
296    {
297        if (result == null)
298            result = new SimpleBitVector(capacity);
299        for (int i = bits.length; i-- > 0;)
300            result.bits[i] = ~(bits[i] | v.bits[i]);
301        return result;
302    }
303
304    SimpleBitVector andc1(SimpleBitVector v, SimpleBitVector result)
305    {
306        if (result == null)
307            result = new SimpleBitVector(capacity);
308        for (int i = bits.length; i-- > 0;)
309            result.bits[i] = ~bits[i] & v.bits[i];
310        return result;
311    }
312
313    SimpleBitVector andc2(SimpleBitVector v, SimpleBitVector result)
314    {
315        if (result == null)
316            result = new SimpleBitVector(capacity);
317        for (int i = bits.length; i-- > 0;)
318            result.bits[i] = bits[i] & ~v.bits[i];
319        return result;
320    }
321
322    SimpleBitVector orc1(SimpleBitVector v, SimpleBitVector result)
323    {
324        if (result == null)
325            result = new SimpleBitVector(capacity);
326        for (int i = bits.length; i-- > 0;)
327            result.bits[i] = ~bits[i] | v.bits[i];
328        return result;
329    }
330
331    SimpleBitVector orc2(SimpleBitVector v, SimpleBitVector result)
332    {
333        if (result == null)
334            result = new SimpleBitVector(capacity);
335        for (int i = bits.length; i-- > 0;)
336            result.bits[i] = bits[i] | ~v.bits[i];
337        return result;
338    }
339
340    // ### %simple-bit-vector-bit-and
341    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_AND =
342        new Primitive("%simple-bit-vector-bit-and", PACKAGE_SYS, false,
343                      "bit-vector1 bit-vector2 result-bit-vector")
344    {
345        @Override
346        public LispObject execute(LispObject first, LispObject second,
347                                  LispObject third)
348
349        {
350            return ((SimpleBitVector)first).and((SimpleBitVector)second,
351                                                ((SimpleBitVector)third));
352        }
353    };
354
355    // ### %simple-bit-vector-bit-ior
356    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_IOR =
357        new Primitive("%simple-bit-vector-bit-ior", PACKAGE_SYS, false,
358                      "bit-vector1 bit-vector2 result-bit-vector")
359    {
360        @Override
361        public LispObject execute(LispObject first, LispObject second,
362                                  LispObject third)
363
364        {
365            return ((SimpleBitVector)first).ior((SimpleBitVector)second,
366                                                (SimpleBitVector)third);
367
368        }
369    };
370
371    // ### %simple-bit-vector-bit-xor
372    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_XOR =
373        new Primitive("%simple-bit-vector-bit-xor", PACKAGE_SYS, false,
374                      "bit-vector1 bit-vector2 result-bit-vector")
375    {
376        @Override
377        public LispObject execute(LispObject first, LispObject second,
378                                  LispObject third)
379
380        {
381            return ((SimpleBitVector)first).xor((SimpleBitVector)second,
382                                                (SimpleBitVector)third);
383
384        }
385    };
386
387    // ### %simple-bit-vector-bit-eqv
388    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_EQV =
389        new Primitive("%simple-bit-vector-bit-eqv", PACKAGE_SYS, false,
390                      "bit-vector1 bit-vector2 result-bit-vector")
391    {
392        @Override
393        public LispObject execute(LispObject first, LispObject second,
394                                  LispObject third)
395
396        {
397            return ((SimpleBitVector)first).eqv((SimpleBitVector)second,
398                                                (SimpleBitVector)third);
399        }
400    };
401
402    // ### %simple-bit-vector-bit-nand
403    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_NAND =
404        new Primitive("%simple-bit-vector-bit-nand", PACKAGE_SYS, false,
405                      "bit-vector1 bit-vector2 result-bit-vector")
406    {
407        @Override
408        public LispObject execute(LispObject first, LispObject second,
409                                  LispObject third)
410
411        {
412            return ((SimpleBitVector)first).nand((SimpleBitVector)second,
413                                                 (SimpleBitVector)third);
414        }
415    };
416
417    // ### %simple-bit-vector-bit-nor
418    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_NOR =
419        new Primitive("%simple-bit-vector-bit-nor", PACKAGE_SYS, false,
420                      "bit-vector1 bit-vector2 result-bit-vector")
421    {
422        @Override
423        public LispObject execute(LispObject first, LispObject second,
424                                  LispObject third)
425
426        {
427            return ((SimpleBitVector)first).nor((SimpleBitVector)second,
428                                                 (SimpleBitVector)third);
429        }
430    };
431
432    // ### %simple-bit-vector-bit-andc1
433    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_ANDC1 =
434        new Primitive("%simple-bit-vector-bit-andc1", PACKAGE_SYS, false,
435                      "bit-vector1 bit-vector2 result-bit-vector")
436    {
437        @Override
438        public LispObject execute(LispObject first, LispObject second,
439                                  LispObject third)
440
441        {
442            return ((SimpleBitVector)first).andc1((SimpleBitVector)second,
443                                                  (SimpleBitVector)third);
444        }
445    };
446
447    // ### %simple-bit-vector-bit-andc2
448    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_ANDC2 =
449        new Primitive("%simple-bit-vector-bit-andc2", PACKAGE_SYS, false,
450                      "bit-vector1 bit-vector2 result-bit-vector")
451    {
452        @Override
453        public LispObject execute(LispObject first, LispObject second,
454                                  LispObject third)
455
456        {
457            return ((SimpleBitVector)first).andc2((SimpleBitVector)second,
458                                                  (SimpleBitVector)third);
459        }
460    };
461
462
463    // ### %simple-bit-vector-bit-orc1
464    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_ORC1 =
465        new Primitive("%simple-bit-vector-bit-orc1", PACKAGE_SYS, false,
466                      "bit-vector1 bit-vector2 result-bit-vector")
467    {
468        @Override
469        public LispObject execute(LispObject first, LispObject second,
470                                  LispObject third)
471
472        {
473            return ((SimpleBitVector)first).orc1((SimpleBitVector)second,
474                                                 (SimpleBitVector)third);
475        }
476    };
477
478    // ### %simple-bit-vector-bit-orc2
479    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_ORC2 =
480        new Primitive("%simple-bit-vector-bit-orc2", PACKAGE_SYS, false,
481                      "bit-vector1 bit-vector2 result-bit-vector")
482    {
483        @Override
484        public LispObject execute(LispObject first, LispObject second,
485                                  LispObject third)
486
487        {
488            return ((SimpleBitVector)first).orc2((SimpleBitVector)second,
489                                                 (SimpleBitVector)third);
490        }
491    };
492
493    // ### %simple-bit-vector-bit-not
494    private static final Primitive _SIMPLE_BIT_VECTOR_BIT_NOT =
495        new Primitive("%simple-bit-vector-bit-not", PACKAGE_SYS, false,
496                      "bit-vector result-bit-vector")
497    {
498        @Override
499        public LispObject execute(LispObject first, LispObject second)
500
501        {
502            SimpleBitVector v = (SimpleBitVector) first;
503            SimpleBitVector result = (SimpleBitVector) second;
504            for (int i = v.bits.length; i-- > 0;)
505                result.bits[i] = ~v.bits[i];
506            return result;
507        }
508    };
509}
Note: See TracBrowser for help on using the repository browser.