YAP 7.1.0
index_absmi_insts.h
1/************************************************************************\
2 * Indexing in ARG1 *
3\************************************************************************/
4
5
6#ifdef INDENT_CODE
7{
8 {
9#endif /* INDENT_CODE */
10
11 BOp(user_switch, lp);
12 {
13 yamop *new = Yap_udi_search(PREG->y_u.lp.p);
14 if (!new) {
15 PREG = PREG->y_u.lp.l;
16 JMPNext();
17 }
18 PREG = new;
19 JMPNext();
20 }
21 ENDBOp();
22
23 BOp(switch_on_type, llll);
24 BEGD(d0);
25 d0 = CACHED_A1();
26 deref_head(d0, swt_unk);
27 /* nonvar */
28 swt_nvar:
29 if (IsPairTerm(d0)) {
30 /* pair */
31 SREG = RepPair(d0);
32 copy_jmp_address(PREG->y_u.llll.l1);
33 PREG = PREG->y_u.llll.l1;
34 JMPNext();
35 }
36 else if (!IsApplTerm(d0)) {
37 /* constant */
38 copy_jmp_address(PREG->y_u.llll.l2);
39 PREG = PREG->y_u.llll.l2;
40 I_R = d0;
41 JMPNext();
42 }
43 else {
44 /* appl */
45 copy_jmp_address(PREG->y_u.llll.l3);
46 PREG = PREG->y_u.llll.l3;
47 SREG = RepAppl(d0);
48 JMPNext();
49 }
50
51 BEGP(pt0);
52 deref_body(d0, pt0, swt_unk, swt_nvar);
53 /* variable */
54 copy_jmp_address(PREG->y_u.llll.l4);
55 PREG = PREG->y_u.llll.l4;
56 JMPNext();
57 ENDP(pt0);
58 ENDD(d0);
59 ENDBOp();
60
61 /* specialised case where the arguments may be:
62 * a list;
63 * the empty list;
64 * some other atom;
65 * a variable;
66 *
67 */
68 BOp(switch_list_nl, ollll);
69 ALWAYS_LOOKAHEAD(PREG->y_u.ollll.pop);
70 BEGD(d0);
71 d0 = CACHED_A1();
72#if UNIQUE_TAG_FOR_PAIRS
73 deref_list_head(d0, swlnl_unk_p);
74 swlnl_list_p:
75 {
76#else
77 deref_head(d0, swlnl_unk_p);
78 /* non variable */
79 swlnl_nvar_p:
80 if (__builtin_expect(IsPairTerm(d0),1)) {
81 /* pair */
82#endif
83 copy_jmp_address(PREG->y_u.ollll.l1);
84 PREG = PREG->y_u.ollll.l1;
85 SREG = RepPair(d0);
86 ALWAYS_GONext();
87 }
88#if UNIQUE_TAG_FOR_PAIRS
89 swlnl_nlist_p:
90#endif
91 if (d0 == TermNil) {
92 /* empty list */
93 PREG = PREG->y_u.ollll.l2;
94 JMPNext();
95 }
96 else {
97 /* appl or constant */
98 if (IsApplTerm(d0)) {
99 copy_jmp_address(PREG->y_u.ollll.l3);
100 PREG = PREG->y_u.ollll.l3;
101 SREG = RepAppl(d0);
102 JMPNext();
103 } else {
104 copy_jmp_address(PREG->y_u.ollll.l3);
105 PREG = PREG->y_u.ollll.l3;
106 I_R = d0;
107 JMPNext();
108 }
109 }
110
111 BEGP(pt0);
112#if UNIQUE_TAG_FOR_PAIRS
113 swlnl_unk_p:
114 deref_list_body(d0, pt0, swlnl_list_p, swlnl_nlist_p);
115#else
116 deref_body(d0, pt0, swlnl_unk_p, swlnl_nvar_p);
117#endif
118 ENDP(pt0);
119 /* variable */
120 copy_jmp_address(PREG->y_u.ollll.l4);
121 PREG = PREG->y_u.ollll.l4;
122 JMPNext();
123 ENDD(d0);
124 }
125 ENDBOp();
126
127 BOp(switch_on_arg_type, xllll);
128 BEGD(d0);
129 d0 = XREG(PREG->y_u.xllll.x);
130 deref_head(d0, arg_swt_unk);
131 /* nonvar */
132 arg_swt_nvar:
133 if (IsPairTerm(d0)) {
134 /* pair */
135 copy_jmp_address(PREG->y_u.xllll.l1);
136 PREG = PREG->y_u.xllll.l1;
137 SREG = RepPair(d0);
138 JMPNext();
139 }
140 else if (!IsApplTerm(d0)) {
141 /* constant */
142 copy_jmp_address(PREG->y_u.xllll.l2);
143 PREG = PREG->y_u.xllll.l2;
144 I_R = d0;
145 JMPNext();
146 }
147 else {
148 /* appl */
149 copy_jmp_address(PREG->y_u.xllll.l3);
150 PREG = PREG->y_u.xllll.l3;
151 SREG = RepAppl(d0);
152 JMPNext();
153 }
154
155 BEGP(pt0);
156 deref_body(d0, pt0, arg_swt_unk, arg_swt_nvar);
157 /* variable */
158 copy_jmp_address(PREG->y_u.xllll.l4);
159 PREG = PREG->y_u.xllll.l4;
160 JMPNext();
161 ENDP(pt0);
162 ENDD(d0);
163 ENDBOp();
164
165 BOp(switch_on_sub_arg_type, sllll);
166 BEGD(d0);
167 d0 = SREG[PREG->y_u.sllll.s];
168 deref_head(d0, sub_arg_swt_unk);
169 /* nonvar */
170 sub_arg_swt_nvar:
171 if (IsPairTerm(d0)) {
172 /* pair */
173 copy_jmp_address(PREG->y_u.sllll.l1);
174 PREG = PREG->y_u.sllll.l1;
175 SREG = RepPair(d0);
176 JMPNext();
177 }
178 else if (!IsApplTerm(d0)) {
179 /* constant */
180 copy_jmp_address(PREG->y_u.sllll.l2);
181 PREG = PREG->y_u.sllll.l2;
182 I_R = d0;
183 JMPNext();
184 }
185 else {
186 /* appl */
187 copy_jmp_address(PREG->y_u.sllll.l3);
188 PREG = PREG->y_u.sllll.l3;
189 SREG = RepAppl(d0);
190 JMPNext();
191 }
192
193 BEGP(pt0);
194 deref_body(d0, pt0, sub_arg_swt_unk, sub_arg_swt_nvar);
195 /* variable */
196 copy_jmp_address(PREG->y_u.sllll.l4);
197 PREG = PREG->y_u.sllll.l4;
198 JMPNext();
199 ENDP(pt0);
200 ENDD(d0);
201 ENDBOp();
202
203 BOp(jump_if_var, l);
204 BEGD(d0);
205 d0 = CACHED_A1();
206 deref_head(d0, jump_if_unk);
207 /* non var */
208 jump0_if_nonvar:
209 PREG = NEXTOP(PREG, l);
210 JMPNext();
211
212 BEGP(pt0);
213 deref_body(d0, pt0, jump_if_unk, jump0_if_nonvar);
214 /* variable */
215 copy_jmp_address(PREG->y_u.l.l);
216 PREG = PREG->y_u.l.l;
217 ENDP(pt0);
218 JMPNext();
219 ENDD(d0);
220 ENDBOp();
221
222 BOp(jump_if_nonvar, xll);
223 BEGD(d0);
224 d0 = XREG(PREG->y_u.xll.x);
225 deref_head(d0, jump2_if_unk);
226 /* non var */
227 jump2_if_nonvar:
228 copy_jmp_address(PREG->y_u.xll.l1);
229 PREG = PREG->y_u.xll.l1;
230 JMPNext();
231
232 BEGP(pt0);
233 deref_body(d0, pt0, jump2_if_unk, jump2_if_nonvar);
234 /* variable */
235 PREG = NEXTOP(PREG, xll);
236 ENDP(pt0);
237 JMPNext();
238 ENDD(d0);
239 ENDBOp();
240
241 BOp(if_not_then, clll);
242 BEGD(d0);
243 d0 = CACHED_A1();
244 deref_head(d0, if_n_unk);
245 if_n_nvar:
246 /* not variable */
247 if (d0 == PREG->y_u.clll.c) {
248 /* equal to test value */
249 copy_jmp_address(PREG->y_u.clll.l2);
250 PREG = PREG->y_u.clll.l2;
251 JMPNext();
252 }
253 else {
254 /* different from test value */
255 /* the case to optimise */
256 copy_jmp_address(PREG->y_u.clll.l1);
257 PREG = PREG->y_u.clll.l1;
258 JMPNext();
259 }
260
261 BEGP(pt0);
262 deref_body(d0, pt0, if_n_unk, if_n_nvar);
263 ENDP(pt0);
264 /* variable */
265 copy_jmp_address(PREG->y_u.clll.l3);
266 PREG = PREG->y_u.clll.l3;
267 JMPNext();
268 ENDD(d0);
269 ENDBOp();
270
271 /************************************************************************\
272 * Indexing on ARG1 *
273\************************************************************************/
274
275#define HASH_SHIFT 6
276
277 BOp(switch_on_func, sssl);
278 BEGD(d1);
279 d1 = *SREG++;
280 /* we use a very simple hash function to find elements in a
281 * switch table */
282 {
283 CELL
284 /* first, calculate the mask */
285 Mask = (PREG->y_u.sssl.s - 1) << 1, /* next, calculate the hash function */
286 hash = d1 >> (HASH_SHIFT - 1) & Mask;
287 CELL *base;
288
289 base = (CELL *)PREG->y_u.sssl.l;
290 /* PREG now points at the beginning of the hash table */
291 BEGP(pt0);
292 /* pt0 will always point at the item */
293 pt0 = base + hash;
294 BEGD(d0);
295 d0 = pt0[0];
296 /* a match happens either if we found the value, or if we
297 * found an empty slot */
298 if (d0 == d1 || d0 == 0) {
299 copy_jmp_addressa(pt0+1);
300 PREG = (yamop *) (pt0[1]);
301 JMPNext();
302 }
303 else {
304 /* ooops, collision, look for other items */
305 register CELL d = ((d1 | 1) << 1) & Mask;
306
307 while (1) {
308 hash = (hash + d) & Mask;
309 pt0 = base + hash;
310 d0 = pt0[0];
311 if (d0 == d1 || d0 == 0) {
312 copy_jmp_addressa(pt0+1);
313 PREG = (yamop *) pt0[1];
314 JMPNext();
315 }
316 }
317 }
318 ENDD(d0);
319 ENDP(pt0);
320 }
321 ENDD(d1);
322 ENDBOp();
323
324 BOp(switch_on_cons, sssl);
325 BEGD(d1);
326 d1 = I_R;
327 /* we use a very simple hash function to find elements in a
328 * switch table */
329 {
330 CELL
331 /* first, calculate the mask */
332 Mask = (PREG->y_u.sssl.s - 1) << 1, /* next, calculate the hash function */
333 hash = d1 >> (HASH_SHIFT - 1) & Mask;
334 CELL *base;
335
336 base = (CELL *)PREG->y_u.sssl.l;
337 /* PREG now points at the beginning of the hash table */
338 BEGP(pt0);
339 /* pt0 will always point at the item */
340 pt0 = base + hash;
341 BEGD(d0);
342 d0 = pt0[0];
343 /* a match happens either if we found the value, or if we
344 * found an empty slot */
345 if (d0 == d1 || d0 == 0) {
346 copy_jmp_addressa(pt0+1);
347 PREG = (yamop *) (pt0[1]);
348 JMPNext();
349 }
350 else {
351 /* ooops, collision, look for other items */
352 register CELL d = ((d1 | 1) << 1) & Mask;
353
354 while (1) {
355 hash = (hash + d) & Mask;
356 pt0 = base + hash;
357 d0 = pt0[0];
358 if (d0 == d1 || d0 == 0) {
359 copy_jmp_addressa(pt0+1);
360 PREG = (yamop *) pt0[1];
361 JMPNext();
362 }
363 }
364 }
365 ENDD(d0);
366 ENDP(pt0);
367 }
368 ENDD(d1);
369 ENDBOp();
370
371 BOp(go_on_func, sssl);
372 BEGD(d0);
373 {
374 CELL *pt = (CELL *)(PREG->y_u.sssl.l);
375
376 d0 = *SREG++;
377 if (d0 == pt[0]) {
378 copy_jmp_addressa(pt+1);
379 PREG = (yamop *) pt[1];
380 JMPNext();
381 } else {
382 copy_jmp_addressa(pt+3);
383 PREG = (yamop *) pt[3];
384 JMPNext();
385 }
386 }
387 ENDD(d0);
388 ENDBOp();
389
390 BOp(go_on_cons, sssl);
391 BEGD(d0);
392 {
393 CELL *pt = (CELL *)(PREG->y_u.sssl.l);
394
395 d0 = I_R;
396 if (d0 == pt[0]) {
397 copy_jmp_addressa(pt+1);
398 PREG = (yamop *) pt[1];
399 JMPNext();
400 } else {
401 copy_jmp_addressa(pt+3);
402 PREG = (yamop *) pt[3];
403 JMPNext();
404 }
405 }
406 ENDD(d0);
407 ENDBOp();
408
409 BOp(if_func, sssl);
410 BEGD(d1);
411 BEGP(pt0);
412 pt0 = (CELL *) PREG->y_u.sssl.l;
413 d1 = *SREG++;
414 while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) {
415 pt0 += 2;
416 }
417 copy_jmp_addressa(pt0+1);
418 PREG = (yamop *) (pt0[1]);
419 JMPNext();
420 ENDP(pt0);
421 ENDD(d1);
422 ENDBOp();
423
424 BOp(if_cons, sssl);
425 BEGD(d1);
426 BEGP(pt0);
427 pt0 = (CELL *) PREG->y_u.sssl.l;
428 d1 = I_R;
429 while (pt0[0] != d1 && pt0[0] != 0L ) {
430 pt0 += 2;
431 }
432 copy_jmp_addressa(pt0+1);
433 PREG = (yamop *) (pt0[1]);
434 JMPNext();
435 ENDP(pt0);
436 ENDD(d1);
437 ENDBOp();
438
439 Op(index_dbref, e);
440 PREG = NEXTOP(PREG, e);
441 I_R = AbsAppl(SREG-1);
442 GONext();
443 ENDOp();
444
445 Op(index_blob, e);
446 PREG = NEXTOP(PREG, e);
447 I_R = Yap_DoubleP_key(SREG);
448 GONext();
449 ENDOp();
450
451 Op(index_long, e);
452 PREG = NEXTOP(PREG, e);
453 I_R = Yap_IntP_key(SREG);
454 GONext();
455 ENDOp();
456
457
458␌
yami
Definition: amidefs.h:264