1 /*
2 * BitwiseProcedures.cpp -
3 *
4 * Copyright (c) 2008 Higepon(Taro Minowa) <higepon@users.sourceforge.jp>
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
18 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
19 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
20 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
21 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
22 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
23 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
24 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
25 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 *
29 * $Id: BitwiseProcedures.cpp 183 2008-07-04 06:19:28Z higepon $
30 */
31
32 #include "Object.h"
33 #include "Object-inl.h"
34 #include "SString.h"
35 #include "ProcedureMacro.h"
36 #include "ErrorProcedures.h"
37 #include "VM.h"
38 #include "Arithmetic.h"
39 #include "BitwiseProcedures.h"
40
41 using namespace scheme;
42
bitwiseNotEx(VM * theVM,int argc,const Object * argv)43 Object scheme::bitwiseNotEx(VM* theVM, int argc, const Object* argv)
44 {
45 DeclareProcedureName("bitwise-not");
46 checkArgumentLength(1);
47 argumentCheckExactInteger(0, e);
48 return Arithmetic::bitwiseNot(e);
49 }
50
bitwiseAndEx(VM * theVM,int argc,const Object * argv)51 Object scheme::bitwiseAndEx(VM* theVM, int argc, const Object* argv)
52 {
53 DeclareProcedureName("bitwise-and");
54 if (0 == argc) {
55 return Object::makeFixnum(-1);
56 } else if (1 == argc) {
57 return argv[0];
58 }
59 argumentCheckExactInteger(0, arg0);
60 Object accum = arg0;
61 for (int i = 1; i < argc; i++) {
62 argumentCheckExactInteger(i, e);
63 accum = Arithmetic::bitwiseAnd(accum, e);
64 }
65 return accum;
66 }
67
bitwiseIorEx(VM * theVM,int argc,const Object * argv)68 Object scheme::bitwiseIorEx(VM* theVM, int argc, const Object* argv)
69 {
70 DeclareProcedureName("bitwise-ior");
71 if (0 == argc) {
72 return Object::makeFixnum(0);
73 } else if (1 == argc) {
74 return argv[0];
75 }
76 argumentCheckExactInteger(0, arg0);
77 Object accum = arg0;
78 for (int i = 1; i < argc; i++) {
79 argumentCheckExactInteger(i, e);
80 accum = Arithmetic::bitwiseIor(accum, e);
81 }
82 return accum;
83 }
84
bitwiseXorEx(VM * theVM,int argc,const Object * argv)85 Object scheme::bitwiseXorEx(VM* theVM, int argc, const Object* argv)
86 {
87 DeclareProcedureName("bitwise-xor");
88 if (0 == argc) {
89 return Object::makeFixnum(0);
90 } else if (1 == argc) {
91 return argv[0];
92 }
93 argumentCheckExactInteger(0, arg0);
94 Object accum = arg0;
95 for (int i = 1; i < argc; i++) {
96 argumentCheckExactInteger(i, e);
97 accum = Arithmetic::bitwiseXor(accum, e);
98 }
99 return accum;
100 }
101
bitwiseBitCountEx(VM * theVM,int argc,const Object * argv)102 Object scheme::bitwiseBitCountEx(VM* theVM, int argc, const Object* argv)
103 {
104 DeclareProcedureName("bitwise-bit-count");
105 checkArgumentLength(1);
106 argumentCheckExactInteger(0, e);
107 return Arithmetic::bitwiseBitCount(e);
108 }
109
bitwiseLengthEx(VM * theVM,int argc,const Object * argv)110 Object scheme::bitwiseLengthEx(VM* theVM, int argc, const Object* argv)
111 {
112 DeclareProcedureName("bitwise-length");
113 checkArgumentLength(1);
114 argumentCheckExactInteger(0, e);
115 return Arithmetic::bitwiseLength(e);
116 }
117
bitwiseFirstBitSetEx(VM * theVM,int argc,const Object * argv)118 Object scheme::bitwiseFirstBitSetEx(VM* theVM, int argc, const Object* argv)
119 {
120 DeclareProcedureName("bitwise-first-bit-set");
121 checkArgumentLength(1);
122 argumentCheckExactInteger(0, e);
123 return Arithmetic::bitwiseFirstBitSet(e);
124 }
125
bitwiseArithmeticShiftLeftEx(VM * theVM,int argc,const Object * argv)126 Object scheme::bitwiseArithmeticShiftLeftEx(VM* theVM, int argc, const Object* argv)
127 {
128 DeclareProcedureName("bitwise-arithmetic-shift-left");
129 checkArgumentLength(2);
130 argumentCheckExactInteger(0, e1);
131 argumentAsFixnum(1, e2);
132
133 if (e2 < 0) {
134 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "fixnum greater than zero", argv[1]);
135 return Object::Undef;
136 } else {
137 return Arithmetic::bitwiseShiftLeft(e1, static_cast<unsigned long>(e2));
138 }
139 }
140
bitwiseArithmeticShiftRightEx(VM * theVM,int argc,const Object * argv)141 Object scheme::bitwiseArithmeticShiftRightEx(VM* theVM, int argc, const Object* argv)
142 {
143 DeclareProcedureName("bitwise-arithmetic-shift-right");
144 checkArgumentLength(2);
145 argumentCheckExactInteger(0, e1);
146 argumentAsFixnum(1, e2);
147
148 if (e2 < 0) {
149 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "fixnum greater than zero", argv[1]);
150 return Object::Undef;
151 } else {
152 return Arithmetic::bitwiseShiftRight(e1, static_cast<unsigned long>(e2));
153 }
154 }
155
bitwiseArithmeticShiftEx(VM * theVM,int argc,const Object * argv)156 Object scheme::bitwiseArithmeticShiftEx(VM* theVM, int argc, const Object* argv)
157 {
158 DeclareProcedureName("bitwise-arithmetic-shift");
159 checkArgumentLength(2);
160 argumentCheckExactInteger(0, e1);
161 argumentAsFixnum(1, e2);
162
163 if (e2 >= 0) {
164 return Arithmetic::bitwiseShiftLeft(e1, static_cast<unsigned long>(e2));
165 } else {
166 return Arithmetic::bitwiseShiftRight(e1, static_cast<unsigned long>(abs(e2)));
167 }
168 }
169