YAP 7.1.0
amiops.h
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: amiops.h *
12 * Last rev: *
13 * mods: *
14 * comments: Basic abstract machine operations, such as *
15 * dereferencing, binding, trailing, and unification. *
16 * *
17 *************************************************************************/
18#ifndef AMIOPS_H
19
20#define AMIOPS_H 1
21
22#ifdef SCCS
23static char SccsId[] = "%W% %G%";
24#endif /* SCCS */
25
26#include "inline-only.h"
27
28extern Functor FunctorAtt1, FunctorAttVar;
29
30#define IsAttVar(pt) __IsAttVar(pt PASS_REGS)
31
32
33INLINE_ONLY bool __IsAttVar(CELL *pt USES_REGS) {
34#ifdef YAP_H
35 return (pt)[-1] == (CELL)FunctorAttVar && pt < HR;
36#else
37 return (pt)[-1] == (CELL)attvar_e;
38#endif
39}
40
41INLINE_ONLY bool GlobalIsAttVar(CELL *pt) {
42 return (pt)[-1] == (CELL)FunctorAttVar;
43}
44
45#define IsArrayReference(a) ((a)->array_access_func == FunctorArrayAccess)
46
47/* dereferencing macros */
48
49/************************************************************
50
51Dereferencing macros
52
53*************************************************************/
54
55/* For DEREFD, D has both the input and the exit argument */
56/* A is only used locally */
57
58#define profiled_deref_head_TEST(D, Label) \
59 if (IsVarTerm(D)) { \
60 if (!strcmp(#D, "d0")) { \
61 EMIT_CONDITIONAL_SUCCESS("IsVarTerm(d0)"); \
62 } else if (!strcmp(#D, "d1")) { \
63 EMIT_CONDITIONAL_SUCCESS("IsVarTerm(d1)"); \
64 } \
65 goto Label; \
66 } \
67 if (!strcmp(#D, "d0")) { \
68 EMIT_CONDITIONAL_FAIL("IsVarTerm(d0)"); \
69 } else if (!strcmp(#D, "d1")) { \
70 EMIT_CONDITIONAL_FAIL("IsVarTerm(d1)"); \
71 }
72
73#define deref_head(D, Label) \
74 if (IsVarTerm(D)) \
75 goto Label
76
77#define profiled_deref_body(D, A, LabelUnk, LabelNonVar) \
78 do { \
79 if (!IsVarTerm(D)) \
80 goto LabelNonVar; \
81 LabelUnk: \
82 (A) = (CELL *)(D); \
83 (D) = *(CELL *)(D); \
84 if (!strcmp(#D, "d0") && !strcmp(#A, "pt0")) { \
85 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D0PT0); \
86 } else if (!strcmp(#D, "d0") && !strcmp(#A, "pt1")) { \
87 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D0PT1); \
88 } else if (!strcmp(#D, "d0") && !strcmp(#A, "S_SREG")) { \
89 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D0S_SREG); \
90 } else if (!strcmp(#D, "d1") && !strcmp(#A, "pt0")) { \
91 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D1PT0); \
92 } else if (!strcmp(#D, "d1") && !strcmp(#A, "pt1")) { \
93 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D1PT1); \
94 } \
95 } while (Unsigned(A) != (D));
96
97#define deref_body(D, A, LabelUnk, LabelNonVar) \
98 do { \
99 if (!IsVarTerm(D)) \
100 goto LabelNonVar; \
101 LabelUnk: \
102 (A) = (CELL *)(D); \
103 (D) = *(CELL *)(D); \
104 } while (Unsigned(A) != (D))
105
106#define deref_body(D, A, LabelUnk, LabelNonVar) \
107 do { \
108 if (!IsVarTerm(D)) \
109 goto LabelNonVar; \
110 LabelUnk: \
111 (A) = (CELL *)(D); \
112 (D) = *(CELL *)(D); \
113 } while (Unsigned(A) != (D))
114
115#define do_derefa(D, A, LabelUnk, LabelDone) \
116 (D) = *(CELL *)(A); \
117 if (IsNonVarTerm(D)) \
118 goto LabelDone; \
119 goto LabelUnk; \
120 do { \
121 (A) = (CELL *)(D); \
122 (D) = *(CELL *)(D); \
123 if (!IsVarTerm(D)) \
124 goto LabelDone; \
125 LabelUnk:; \
126 } while (Unsigned(A) != (D)); \
127 LabelDone:
128
129#define profiled_derefa_body(D, A, LabelUnk, LabelNonVar) \
130 do { \
131 (A) = (CELL *)(D); \
132 (D) = *(CELL *)(D); \
133 if (!strcmp(#D, "d0") && !strcmp(#A, "pt0")) { \
134 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D0PT0); \
135 } else if (!strcmp(#D, "d0") && !strcmp(#A, "pt1")) { \
136 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D0PT1); \
137 } else if (!strcmp(#D, "d0") && !strcmp(#A, "S_SREG")) { \
138 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D0S_SREG); \
139 } else if (!strcmp(#D, "d1") && !strcmp(#A, "pt0")) { \
140 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D1PT0); \
141 } else if (!strcmp(#D, "d1") && !strcmp(#A, "pt1")) { \
142 EMIT_SIMPLE_BLOCK_TEST(YAAM_DEREF_BODY_D1PT1); \
143 } \
144 if (!IsVarTerm(D)) \
145 goto LabelNonVar; \
146 LabelUnk:; \
147 } while (Unsigned(A) != (D));
148
149#define derefa_body(D, A, LabelUnk, LabelNonVar) \
150 do { \
151 (A) = (CELL *)(D); \
152 (D) = *(CELL *)(D); \
153 if (!IsVarTerm(D)) \
154 goto LabelNonVar; \
155 LabelUnk:; \
156 } while (Unsigned(A) != (D))
157
158#if UNIQUE_TAG_FOR_PAIRS
159
160/* If you have an unique tag for pairs you can use these macros which will
161 speed up detection of dereferenced pairs, but will be slow
162 for the other cases.
163
164 The only instruction where this seems useful is
165 switch_list_nl
166*/
167
168#define deref_list_head(D, Label) \
169 if (!IsPairTerm(D)) \
170 goto Label
171
172#define deref_list_body(D, A, LabelList, LabelNonVar) \
173 do { \
174 if (!IsVarTerm(D)) \
175 goto LabelNonVar; \
176 (A) = (CELL *)(D); \
177 (D) = *(A); \
178 if (Unsigned(A) == (D)) \
179 break; \
180 if (IsPairTerm(D)) \
181 goto LabelList; \
182 } while (TRUE);
183
184INLINE_ONLY CELL *deref_ptr(CELL *A);
185
186INLINE_ONLY CELL *deref_ptr(CELL *A) {
187 Term D = *A;
188 do {
189 if (!IsVarTerm(D))
190 return A;
191 (A) = (CELL *)(D);
192 (D) = *(A);
193 if (Unsigned(A) == (D))
194 return A;
195 } while (TRUE);
196}
197#endif /* UNIQUE_TAG_FOR_PAIRS */
198
199/************************************************************
200
201TRAIL VARIABLE
202
203A contains the address of the variable that is to be trailed
204
205*************************************************************/
206
207#define RESET_VARIABLE(V) (*(CELL *)(V) = Unsigned(V))
208
209#ifdef TABLING
210
211#define DO_TRAIL(TERM, VAL) \
212 { \
213 tr_fr_ptr r; \
214 r = TR; \
215 TR = r + 1; \
216 TrailTerm(r) = (Term)(TERM); \
217 TrailVal(r) = (CELL)(VAL); \
218 }
219
220#ifdef BFZ_TRAIL_SCHEME
221
222#define TRAIL(TERM, VAL) \
223 if (OUTSIDE(HBREG, TERM, B) || ((TERM) > (CELL *)B_FZ)) \
224 DO_TRAIL(TERM, VAL)
225
226#define TRAIL_LOCAL(TERM, VAL) \
227 if ((TERM) > (CELL *)B || (TERM) > (CELL *)B_FZ) \
228 DO_TRAIL(TERM, VAL)
229
230#else /* BBREG_TRAIL_SCHEME */
231
232#define TRAIL(TERM, VAL) \
233 if (OUTSIDE(HBREG, TERM, BBREG)) \
234 DO_TRAIL(TERM, VAL)
235
236#define TRAIL_LOCAL(TERM, VAL) \
237 if ((TERM) > (CELL *)BBREG) \
238 DO_TRAIL(TERM, VAL)
239
240#endif /* TRAIL_SCHEME */
241
242/* ------------------------------------------------------ */
243
244#define TRAIL_GLOBAL(TERM, VAL) \
245 if ((TERM) < HBREG) \
246 DO_TRAIL(TERM, VAL)
247
248#define DO_MATRAIL(TERM, OLDVAL, NEWVAL) \
249 { \
250 register tr_fr_ptr r = TR; \
251 TR = r + 2; \
252 TrailVal(r) = (OLDVAL); \
253 TrailTerm(r) = TrailTerm(r + 1) = AbsAppl((CELL *)(TERM)); \
254 TrailVal(r + 1) = (NEWVAL); \
255 }
256
257#define MATRAIL(TERM, OVAL, VAL) \
258 if (OUTSIDE(HBREG, TERM, B)) \
259 DO_MATRAIL(TERM, OVAL, VAL)
260
261#else /* TABLING */
262
263#if defined(i386) && !defined(TERM_EXTENSIONS)
264
265#define DO_TRAIL(A, D) \
266 { \
267 tr_fr_ptr r; \
268 r = TR; \
269 TR = r + 1; \
270 TrailTerm(r) = (CELL)(A); \
271 }
272
273#define TRAIL(A, D) \
274 if (OUTSIDE(HBREG, A, B)) \
275 DO_TRAIL(A, D);
276
277#define TRAIL_GLOBAL(A, D) \
278 if ((A) < HBREG) \
279 DO_TRAIL(A, D);
280
281#define TRAIL_LOCAL(A, D) \
282 if ((A) > (CELL *)B) \
283 DO_TRAIL(A, D);
284
285#elif defined(__alpha) && !defined(TERM_EXTENSIONS)
286
287/* alpha machines have a move conditional instruction, which avoids a
288 branch when jumping */
289#define TRAIL(A, D) \
290 TrailTerm(TR) = (CELL)(A); \
291 if (OUTSIDE(HBREG, A, B)) \
292 TR++
293
294#define TRAIL(A, D) \
295 TrailTerm(TR) = (CELL)(A); \
296 if (!OUTSIDE(HBREG, A, B)) \
297 GONext();
298
299#define TRAIL_GLOBAL(A, D) \
300 TR[0] = (CELL)(A); \
301 if ((A) < HBREG) \
302 TR++
303
304#define TRAIL_LOCAL(A, D) \
305 TR[0] = (CELL)(A); \
306 if ((A) > ((CELL *)(B))) \
307 TR++
308
309#elif !defined(TERM_EXTENSIONS)
310
311#define DO_TRAIL(A, D) TrailTerm(TR++) = (CELL)(A)
312
313#define TRAIL(A, D) \
314 if (OUTSIDE(HBREG, A, B)) \
315 DO_TRAIL(A, D)
316
317#define TRAIL_AND_JUMP(A, D) \
318 if (IN_BETWEEN(HBREG, A, B)) \
319 GONext(); \
320 DO_TRAIL(A, D)
321
322#define TRAIL_GLOBAL(A, D) \
323 if ((A) < HBREG) \
324 DO_TRAIL(A, D)
325
326#define TRAIL_LOCAL(A, D) \
327 if ((A) > ((CELL *)B)) \
328 DO_TRAIL(A, D)
329
330#else
331
332#define DO_TRAIL(A, D) TrailTerm(TR++) = (CELL)(A)
333
334#define TRAIL(A, D) \
335 if (OUTSIDE(HBREG, A, B)) \
336 DO_TRAIL(A, D)
337
338#define TrailAndJump(A, D) \
339 if (IN_BETWEEN(HBREG, A, B)) \
340 GONext();
341
342#define TRAIL_GLOBAL(A, D) \
343 if ((A) < HBREG) \
344 DO_TRAIL(A, D)
345
346#define TRAIL_LOCAL(A, D) \
347 if ((A) > ((CELL *)B)) \
348 DO_TRAIL(A, D)
349
350#endif
351
352/************************************************************
353
354Binding Macros for Multiple Assignment Variables.
355
356************************************************************/
357
358#define DO_MATRAIL(VP, OLDV, D) \
359 { \
360 TrailTerm(TR + 1) = OLDV; \
361 TrailTerm(TR) = TrailTerm(TR + 2) = AbsAppl(VP); \
362 TR += 3; \
363 }
364
365#define MATRAIL(VP, OLDV, D) \
366 if (OUTSIDE(HBREG, VP, B)) \
367 DO_MATRAIL(VP, OLDV, D)
368
369#endif /* TABLING */
370
371#define REF_TO_TRENTRY(REF) AbsPair(((CELL *)&((REF)->Flags)))
372#define CLREF_TO_TRENTRY(REF) AbsPair(((CELL *)&((REF)->ClFlags)))
373
374#if FROZEN_STACKS
375#define TRAIL_REF(REF) \
376 RESET_VARIABLE(&TrailVal(TR)), TrailTerm(TR++) = REF_TO_TRENTRY(REF)
377#define TRAIL_CLREF(REF) \
378 RESET_VARIABLE(&TrailVal(TR)), TrailTerm(TR++) = CLREF_TO_TRENTRY(REF)
379#define TRAIL_LINK(REF) \
380 RESET_VARIABLE(&TrailVal(TR)), TrailTerm(TR++) = AbsPair((CELL *)(REF))
381#else
382#define TRAIL_REF(REF) TrailTerm(TR++) = REF_TO_TRENTRY(REF)
383#define TRAIL_CLREF(REF) TrailTerm(TR++) = CLREF_TO_TRENTRY(REF)
384#define TRAIL_LINK(REF) TrailTerm(TR++) = AbsPair((CELL *)(REF))
385#endif
386#define TRAIL_FRAME(FR) DO_TRAIL(AbsPair((CELL *)(LOCAL_TrailBase)), FR)
387
388extern void Yap_WakeUp(CELL *v);
389
390#define Bind_Local(A, D) \
391 { \
392 TRAIL_LOCAL(A, D); \
393 *(A) = (D); \
394 }
395#define Bind_Global(A, D) \
396 { \
397 *(A) = (D); \
398 if (__builtin_expect(GlobalIsAttVar(A), 0)) \
399 Yap_WakeUp(A); \
400 else \
401 TRAIL_GLOBAL(A, D); \
402 }
403#define YapBind(A, D) \
404 { \
405 *(A) = (D); \
406 if (A < HR) { \
407 if (__builtin_expect(GlobalIsAttVar(A), 0)) \
408 Yap_WakeUp(A); \
409 else \
410 TRAIL_GLOBAL(A, D); \
411 } else { \
412 TRAIL_LOCAL(A, D); \
413 } \
414 }
415#define Bind_NonAtt(A, D) \
416 { \
417 *(A) = (D); \
418 TRAIL(A, D); \
419 }
420#define Bind_Global_NonAtt(A, D) \
421 { \
422 *(A) = (D); \
423 TRAIL_GLOBAL(A, D); \
424 }
425#define Bind_and_Trail(A, D) \
426 { \
427 *(A) = (D); \
428 DO_TRAIL(A, D); \
429 }
430// #define Bind(A,D) YapBind(A,D) conflicts with Windows headers
431
432#define MaBind(VP, D) \
433 { \
434 MATRAIL((VP), *(VP), (D)); \
435 *(VP) = (D); \
436 }
437
438/************************************************************
439
440Unification Routines
441
442*************************************************************/
443
444INLINE_ONLY void reset_trail(tr_fr_ptr TR0);
445
446INLINE_ONLY void reset_trail(tr_fr_ptr TR0) {
447 CACHE_REGS
448 while (TR != TR0) {
449 CELL d1;
450 --TR;
451 d1 = TrailTerm(TR);
452#ifdef MULTI_ASSIGNMENT_VARIABLES
453 if (IsVarTerm(d1)) {
454#endif
455 CELL *pt = (CELL *)d1;
456 RESET_VARIABLE(pt);
457#ifdef MULTI_ASSIGNMENT_VARIABLES
458 } else {
459 CELL *pt = RepAppl(d1);
460/* AbsAppl means */
461/* multi-assignment variable */
462/* so the next cell is the old value */
463#ifdef FROZEN_STACKS
464 pt[0] = TrailVal(TR - 1);
465 TR -= 1;
466#else
467 pt[0] = TrailTerm(TR - 1);
468 TR -= 2;
469#endif /* FROZEN_STACKS */
470 }
471#endif
472 }
473}
474
475INLINE_ONLY void reset_attvars(CELL *dvarsmin, CELL *dvarsmax);
476
477INLINE_ONLY void reset_attvars(CELL *dvarsmin, CELL *dvarsmax) {
478 if (dvarsmin) {
479 dvarsmin += 1;
480 do {
481 CELL *newv;
482 newv = CellPtr(*dvarsmin);
483 RESET_VARIABLE(dvarsmin + 1);
484 if (IsUnboundVar(dvarsmin))
485 break;
486 RESET_VARIABLE(dvarsmin);
487 dvarsmin = newv;
488 } while (TRUE);
489 }
490}
491
492INLINE_ONLY void close_attvar_chain(CELL *dvarsmin,
493 CELL *dvarsmax);
494
495INLINE_ONLY void close_attvar_chain(CELL *dvarsmin,
496 CELL *dvarsmax) {
497 CACHE_REGS
498 if (dvarsmin) {
499 dvarsmin += 1;
500 do {
501 CELL *newv;
502 YapBind(dvarsmin + 1, dvarsmin[1]);
503 if (IsUnboundVar(dvarsmin))
504 break;
505 newv = CellPtr(*dvarsmin);
506 RESET_VARIABLE(dvarsmin);
507 dvarsmin = newv;
508 } while (TRUE);
509 }
510}
511
512INLINE_ONLY bool Yap_unify(Term t0, Term t1);
513
514INLINE_ONLY bool Yap_unify(Term t0, Term t1) {
515 CACHE_REGS
516 tr_fr_ptr TR0 = TR;
517
518 if (Yap_IUnify(t0, t1)) {
519 return true;
520 } else {
521 reset_trail(TR0);
522 return false;
523 }
524}
525
526INLINE_ONLY Int Yap_unify_constant(Term a, Term cons);
527
528INLINE_ONLY Int Yap_unify_constant(Term a, Term cons) {
529 CACHE_REGS
530 CELL *pt;
531 deref_head(a, unify_cons_unk);
532unify_cons_nonvar : {
533 if (a == cons)
534 return (TRUE);
535 else if (IsApplTerm(a)) {
536 Functor f;
537 if (!IsApplTerm(cons))
538 return (FALSE);
539 f = FunctorOfTerm(a);
540 if (f != FunctorOfTerm(cons))
541 return (FALSE);
542 if (IsExtensionFunctor(f)) {
543 switch ((CELL)f) {
544 case db_ref_e:
545 return (a == cons);
546 case long_int_e: {
547 CELL d0 = RepAppl(a)[1];
548 CELL d1 = RepAppl(cons)[1];
549 return d0 == d1;
550 }
551 case double_e: {
552 Float d0 = FloatOfTerm(a);
553 Float d1 = FloatOfTerm(cons);
554 return d0 == d1;
555 }
556 case big_int_e:
557#ifdef USE_GMP
558 return (Yap_gmp_tcmp_big_big(a, cons) == 0);
559#endif /* USE_GMP */
560 default:
561 return FALSE;
562 }
563 }
564 } else
565 return FALSE;
566}
567
568 deref_body(a, pt, unify_cons_unk, unify_cons_nonvar);
569 YapBind(pt, cons);
570 return (TRUE);
571}
572
573#define EQ_OK_IN_CMP 1
574#define LT_OK_IN_CMP 2
575#define GT_OK_IN_CMP 4
576
577static inline int do_cut(int i) {
578 CACHE_REGS
579 if (POP_CHOICE_POINT(B->cp_b)) {
580 cut_c_pop();
581 }
582 Yap_TrimTrail();
583 B = B->cp_b;
584 return i;
585}
586
587#define cut_succeed() return do_cut(TRUE)
588
589#define cut_fail() return do_cut(FALSE)
590
591INLINE_ONLY Term MkGlobal(Term t)
592{
593 if (!IsVarTerm((t = Deref(t)))) return t;
594 Term *pt = VarOfTerm(t);
595 if (H0<=pt && HR> pt)
596 return t;
597 Term nt = MkVarTerm();
598 YapBind(pt, nt);
599 return nt;
600}
601
602
603#endif