1 /*
2 * %CopyrightBegin%
3 *
4 * Copyright Ericsson AB 1999-2016. All Rights Reserved.
5 *
6 * Licensed under the Apache License, Version 2.0 (the "License");
7 * you may not use this file except in compliance with the License.
8 * You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing, software
13 * distributed under the License is distributed on an "AS IS" BASIS,
14 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 * See the License for the specific language governing permissions and
16 * limitations under the License.
17 *
18 * %CopyrightEnd%
19 */
20
21 /*
22 * Operator BIFs.
23 */
24
25 #ifdef HAVE_CONFIG_H
26 # include "config.h"
27 #endif
28
29 #include "sys.h"
30 #include "erl_vm.h"
31 #include "global.h"
32 #include "erl_process.h"
33 #include "error.h"
34 #include "erl_driver.h"
35 #include "bif.h"
36 #include "big.h"
37 #include "dist.h"
38 #include "erl_version.h"
39 #include "erl_binary.h"
40 #include "erl_map.h"
41
and_2(BIF_ALIST_2)42 BIF_RETTYPE and_2(BIF_ALIST_2)
43 {
44 if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true)
45 BIF_RET(am_true);
46 else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false)
47 BIF_RET(am_false);
48 else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true)
49 BIF_RET(am_false);
50 else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false)
51 BIF_RET(am_false);
52 BIF_ERROR(BIF_P, BADARG);
53 }
54
or_2(BIF_ALIST_2)55 BIF_RETTYPE or_2(BIF_ALIST_2)
56 {
57 if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true)
58 BIF_RET(am_true);
59 else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false)
60 BIF_RET(am_true);
61 else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true)
62 BIF_RET(am_true);
63 else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false)
64 BIF_RET(am_false);
65 BIF_ERROR(BIF_P, BADARG);
66 }
67
xor_2(BIF_ALIST_2)68 BIF_RETTYPE xor_2(BIF_ALIST_2)
69 {
70 if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true)
71 BIF_RET(am_false);
72 else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false)
73 BIF_RET(am_true);
74 else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true)
75 BIF_RET(am_true);
76 else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false)
77 BIF_RET(am_false);
78 BIF_ERROR(BIF_P, BADARG);
79 }
80
not_1(BIF_ALIST_1)81 BIF_RETTYPE not_1(BIF_ALIST_1)
82 {
83 if (BIF_ARG_1 == am_true)
84 BIF_RET(am_false);
85 else if (BIF_ARG_1 == am_false)
86 BIF_RET(am_true);
87 BIF_ERROR(BIF_P, BADARG);
88 }
89
sgt_2(BIF_ALIST_2)90 BIF_RETTYPE sgt_2(BIF_ALIST_2)
91 {
92 BIF_RET(CMP_GT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
93 }
94
sge_2(BIF_ALIST_2)95 BIF_RETTYPE sge_2(BIF_ALIST_2)
96 {
97 BIF_RET(CMP_GE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
98 }
99
slt_2(BIF_ALIST_2)100 BIF_RETTYPE slt_2(BIF_ALIST_2)
101 {
102 BIF_RET(CMP_LT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
103 }
104
sle_2(BIF_ALIST_2)105 BIF_RETTYPE sle_2(BIF_ALIST_2)
106 {
107 BIF_RET(CMP_LE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
108 }
109
seq_2(BIF_ALIST_2)110 BIF_RETTYPE seq_2(BIF_ALIST_2)
111 {
112 BIF_RET(eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
113 }
114
seqeq_2(BIF_ALIST_2)115 BIF_RETTYPE seqeq_2(BIF_ALIST_2)
116 {
117 BIF_RET(CMP_EQ(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
118 }
119
sneq_2(BIF_ALIST_2)120 BIF_RETTYPE sneq_2(BIF_ALIST_2)
121 {
122 BIF_RET(eq(BIF_ARG_1, BIF_ARG_2) ? am_false : am_true);
123 }
124
sneqeq_2(BIF_ALIST_2)125 BIF_RETTYPE sneqeq_2(BIF_ALIST_2)
126 {
127 BIF_RET(CMP_NE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
128 }
129
is_atom_1(BIF_ALIST_1)130 BIF_RETTYPE is_atom_1(BIF_ALIST_1)
131 {
132 if (is_atom(BIF_ARG_1)) {
133 BIF_RET(am_true);
134 }
135 BIF_RET(am_false);
136 }
137
is_float_1(BIF_ALIST_1)138 BIF_RETTYPE is_float_1(BIF_ALIST_1)
139 {
140 if (is_float(BIF_ARG_1)) {
141 BIF_RET(am_true);
142 }
143 BIF_RET(am_false);
144 }
145
is_integer_1(BIF_ALIST_1)146 BIF_RETTYPE is_integer_1(BIF_ALIST_1)
147 {
148 if (is_integer(BIF_ARG_1)) {
149 BIF_RET(am_true);
150 }
151 BIF_RET(am_false);
152 }
153
is_list_1(BIF_ALIST_1)154 BIF_RETTYPE is_list_1(BIF_ALIST_1)
155 {
156 if (is_list(BIF_ARG_1) || is_nil(BIF_ARG_1)) {
157 BIF_RET(am_true);
158 }
159 BIF_RET(am_false);
160 }
161
is_number_1(BIF_ALIST_1)162 BIF_RETTYPE is_number_1(BIF_ALIST_1)
163 {
164 if (is_number(BIF_ARG_1)) {
165 BIF_RET(am_true);
166 }
167 BIF_RET(am_false);
168 }
169
170
is_pid_1(BIF_ALIST_1)171 BIF_RETTYPE is_pid_1(BIF_ALIST_1)
172 {
173 if (is_pid(BIF_ARG_1)) {
174 BIF_RET(am_true);
175 }
176 BIF_RET(am_false);
177 }
178
is_port_1(BIF_ALIST_1)179 BIF_RETTYPE is_port_1(BIF_ALIST_1)
180 {
181 if (is_port(BIF_ARG_1)) {
182 BIF_RET(am_true);
183 }
184 BIF_RET(am_false);
185 }
186
is_reference_1(BIF_ALIST_1)187 BIF_RETTYPE is_reference_1(BIF_ALIST_1)
188 {
189 if (is_ref(BIF_ARG_1)) {
190 BIF_RET(am_true);
191 }
192 BIF_RET(am_false);
193 }
194
is_tuple_1(BIF_ALIST_1)195 BIF_RETTYPE is_tuple_1(BIF_ALIST_1)
196 {
197 if (is_tuple(BIF_ARG_1)) {
198 BIF_RET(am_true);
199 }
200 BIF_RET(am_false);
201 }
202
is_binary_1(BIF_ALIST_1)203 BIF_RETTYPE is_binary_1(BIF_ALIST_1)
204 {
205 if (is_binary(BIF_ARG_1) && binary_bitsize(BIF_ARG_1) == 0) {
206 BIF_RET(am_true);
207 }
208 BIF_RET(am_false);
209 }
210
is_bitstring_1(BIF_ALIST_1)211 BIF_RETTYPE is_bitstring_1(BIF_ALIST_1)
212 {
213 if (is_binary(BIF_ARG_1)) {
214 BIF_RET(am_true);
215 }
216 BIF_RET(am_false);
217 }
218
is_function_1(BIF_ALIST_1)219 BIF_RETTYPE is_function_1(BIF_ALIST_1)
220 {
221 if (is_any_fun(BIF_ARG_1)) {
222 BIF_RET(am_true);
223 } else {
224 BIF_RET(am_false);
225 }
226 }
227
is_function_2(BIF_ALIST_2)228 BIF_RETTYPE is_function_2(BIF_ALIST_2)
229 {
230 BIF_RET(erl_is_function(BIF_P, BIF_ARG_1, BIF_ARG_2));
231 }
232
erl_is_function(Process * p,Eterm arg1,Eterm arg2)233 Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2)
234 {
235 Sint arity;
236
237 /*
238 * Verify argument 2 (arity); arity must be >= 0.
239 */
240 if (is_small(arg2)) {
241 arity = signed_val(arg2);
242 if (arity < 0) {
243 error:
244 BIF_ERROR(p, BADARG);
245 }
246 } else if (is_big(arg2) && !bignum_header_is_neg(*big_val(arg2))) {
247 /* A positive bignum is OK, but can't possibly match. */
248 arity = -1;
249 } else {
250 /* Everything else (including negative bignum) is an error. */
251 goto error;
252 }
253
254 if (is_fun(arg1)) {
255 ErlFunThing* funp = (ErlFunThing *) fun_val(arg1);
256
257 if (funp->arity == (Uint) arity) {
258 BIF_RET(am_true);
259 }
260 } else if (is_export(arg1)) {
261 Export* exp = (Export *) (export_val(arg1)[1]);
262
263 if (exp->info.mfa.arity == (Uint) arity) {
264 BIF_RET(am_true);
265 }
266 }
267 BIF_RET(am_false);
268 }
269
is_boolean_1(BIF_ALIST_1)270 BIF_RETTYPE is_boolean_1(BIF_ALIST_1)
271 {
272 if (BIF_ARG_1 == am_true || BIF_ARG_1 == am_false) {
273 BIF_RET(am_true);
274 } else {
275 BIF_RET(am_false);
276 }
277 }
278
279
280
281 /*
282 * The compiler usually translates calls to is_record/2 to more primitive
283 * operations. In some cases this is not possible. We'll need to implement
284 * a weak version of is_record/2 as BIF (the size of the record cannot
285 * be verified).
286 */
is_record_2(BIF_ALIST_2)287 BIF_RETTYPE is_record_2(BIF_ALIST_2)
288 {
289 Eterm *t;
290
291 if (is_not_atom(BIF_ARG_2)) {
292 BIF_ERROR(BIF_P, BADARG);
293 }
294
295 if (is_tuple(BIF_ARG_1) &&
296 arityval(*(t = tuple_val(BIF_ARG_1))) >= 1 &&
297 t[1] == BIF_ARG_2) {
298 BIF_RET(am_true);
299 }
300 BIF_RET(am_false);
301 }
302
303
304 /*
305 * Record test cannot actually be a bif. The epp processor is involved in
306 * the real guard test, we have to add one more parameter, the
307 * return value of record_info(size, Rec), which is the arity of the TUPLE.
308 * his may seem awkward when applied from the shell, where the plain
309 * tuple test is more understandable, I think...
310 */
is_record_3(BIF_ALIST_3)311 BIF_RETTYPE is_record_3(BIF_ALIST_3)
312 {
313 Eterm *t;
314 if (is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) {
315 BIF_ERROR(BIF_P, BADARG);
316 }
317
318 if (is_tuple(BIF_ARG_1) &&
319 arityval(*(t = tuple_val(BIF_ARG_1))) == signed_val(BIF_ARG_3)
320 && t[1] == BIF_ARG_2) {
321 BIF_RET(am_true);
322 }
323 BIF_RET(am_false);
324 }
325
is_map_1(BIF_ALIST_1)326 BIF_RETTYPE is_map_1(BIF_ALIST_1)
327 {
328 if (is_map(BIF_ARG_1)) {
329 BIF_RET(am_true);
330 }
331 BIF_RET(am_false);
332 }
333