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