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:		absmi.c							 *
12 * Last rev:								 *
13 * mods:									 *
14 * comments:	Portable abstract machine interpreter includes           *
15 *									 *
16 *************************************************************************/
17 
18 #ifdef SCCS
19 static char SccsId[] = "%W% %G%";
20 
21 #endif /* SCCS */
22 
23 #if NATIVE_EXECUTION
24 /* just a stub */
25 #else
26 #define	  EXEC_NATIVE(X)
27 #define	  MAX_INVOCATION 1024
28 #define	  Yapc_Compile(P) 0
29 #endif
30 
31 /***************************************************************
32 * Macros for register manipulation                             *
33 ***************************************************************/
34 /*
35  * Machine and compiler dependent definitions
36  */
37 #ifdef __GNUC__
38 
39 #ifdef hppa
40 #define SHADOW_P       1
41 #define SHADOW_Y       1
42 #define SHADOW_REGS    1
43 #define USE_PREFETCH   1
44 #endif
45 
46 #ifdef __alpha
47 #define SHADOW_P       1
48 #define SHADOW_Y       1
49 #define SHADOW_REGS    1
50 #define USE_PREFETCH   1
51 #endif
52 
53 #ifdef mips
54 #define SHADOW_P       1
55 #define SHADOW_Y       1
56 #define SHADOW_REGS    1
57 #define USE_PREFETCH   1
58 #endif
59 
60 #if defined(_POWER) || defined(__POWERPC__)
61 #define SHADOW_P       1
62 #define SHADOW_REGS    1
63 #define USE_PREFETCH   1
64 #endif
65 
66 #ifdef i386
67 #define      Y_IN_MEM  1
68 #define      S_IN_MEM  1
69 #define     TR_IN_MEM  1
70 #define HAVE_FEW_REGS  1
71 #define LIMITED_PREFETCH   1
72 #ifdef BP_FREE
73 /***************************************************************
74 * Use bp as PREG for X86 machines		               *
75 ***************************************************************/
76 #if defined(IN_ABSMI_C)
77 register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
78 #define PREG P1REG
79 #endif
80 #define NEEDS_TO_SET_PC 1
81 #endif /* BP_FREE */
82 #endif /* i386 */
83 
84 #ifdef sparc
85 #define SHADOW_P       1
86 #ifdef BP_FREE
87 #undef BP_FREE
88 #endif
89 #define S_IN_MEM       1
90 #define      Y_IN_MEM  1
91 #define     TR_IN_MEM  1
92 #endif /* sparc_ */
93 
94 #ifdef __x86_64__
95 #define SHADOW_P       1
96 #ifdef BP_FREE
97 #undef BP_FREE
98 #endif
99 #define SHADOW_REGS    1
100 #define SHADOW_S       1
101 //#define SHADOW_Y       1
102 #define S_IN_MEM       1
103 #define      Y_IN_MEM  1
104 #define     TR_IN_MEM  1
105 #define USE_PREFETCH   1
106 #endif /* __x86_64__ */
107 
108 #else /* other compilers */
109 
110 #define S_IN_MEM       1
111 
112 /* This works for xlc under AIX 3.2.5 */
113 #ifdef _IBMR2
114 #define SHADOW_P       1
115 #define SHADOW_REGS    1
116 #define SHADOW_S       1
117 #endif
118 
119 #ifdef i386
120 #define Y_IN_MEM       1
121 #define S_IN_MEM       1
122 #define TR_IN_MEM      1
123 #define HAVE_FEW_REGS  1
124 #endif
125 
126 #ifdef mips
127 #define SHADOW_P       1
128 #define SHADOW_Y       1
129 #define SHADOW_S       1
130 #define SHADOW_CP      1
131 #define SHADOW_HB      1
132 #define USE_PREFETCH   1
133 #endif
134 
135 #ifdef _HPUX_SOURCE
136 #define SHADOW_P       1
137 #define SHADOW_Y       1
138 #define SHADOW_S       1
139 #define SHADOW_CP      1
140 #define SHADOW_HB      1
141 #define USE_PREFETCH   1
142 #endif
143 
144 #endif /* __GNUC__ */
145 
146 #include "Yap.h"
147 #include "clause.h"
148 #include "eval.h"
149 #ifdef HAVE_STRING_H
150 #include <string.h>
151 #endif
152 #ifdef YAPOR
153 #include "or.macros.h"
154 #endif	/* YAPOR */
155 #ifdef USE_SYSTEM_MALLOC
156 #include "YapHeap.h"
157 #endif
158 #ifdef TABLING
159 #include "tab.macros.h"
160 #endif /* TABLING */
161 #ifdef LOW_LEVEL_TRACER
162 #include "tracer.h"
163 #endif
164 #ifdef DEBUG
165 /**********************************************************************
166  *                                                                    *
167  *                 Debugging Auxiliary variables                      *
168  *                                                                    *
169  **********************************************************************/
170 #include <stdio.h>
171 #endif
172 
173 #if PUSH_REGS
174 
175 /***************************************************************
176 * Trick to copy REGS into absmi local environment              *
177 ***************************************************************/
178 
179 /* regp is a global variable */
180 
181 inline EXTERN void
init_absmi_regs(REGSTORE * absmi_regs)182 init_absmi_regs(REGSTORE * absmi_regs)
183 {
184   memcpy(absmi_regs, Yap_regp, sizeof(REGSTORE));
185 }
186 
187 inline EXTERN void
restore_absmi_regs(REGSTORE * old_regs)188 restore_absmi_regs(REGSTORE * old_regs)
189 {
190   memcpy(old_regs, Yap_regp, sizeof(REGSTORE));
191 #ifdef THREADS
192   pthread_setspecific(Yap_yaamregs_key, (void *)old_regs);
193   MY_ThreadHandle.current_yaam_regs = old_regs;
194 #else
195   Yap_regp = old_regs;
196 #endif
197 }
198 #endif /* PUSH_REGS */
199 
200 /*****************************************************************
201 
202    Machine Dependent stuff
203 
204 ******************************************************************/
205 
206 #ifdef LONG_LIVED_REGISTERS
207 
208 #define BEGP(TMP)
209 
210 #define ENDP(TMP)
211 
212 #define BEGD(TMP)
213 
214 #define ENDD(TMP)
215 
216 #else
217 
218 #define BEGP(TMP) { register CELL *TMP
219 
220 #define ENDP(TMP) }
221 
222 #define BEGD(TMP) { register CELL TMP
223 
224 #define ENDD(TMP) }
225 
226 #endif /* LONG_LIVED_REGISTERS */
227 
228 #define BEGCHO(TMP) { register choiceptr TMP
229 
230 #define ENDCHO(TMP) }
231 
232 /***************************************************************
233 * YREG is usually, but not always, a register. This affects       *
234 * choicepoints                                                 *
235 ***************************************************************/
236 
237 #if Y_IN_MEM
238 
239 #define CACHE_Y(A) { register CELL *S_YREG = ((CELL *)(A))
240 
241 #define ENDCACHE_Y() YREG = S_YREG; }
242 
243 #define B_YREG   ((choiceptr)(S_YREG))
244 
245 #else
246 
247 #define S_YREG   (YREG)
248 
249 #define B_YREG ((choiceptr)(YREG))
250 
251 #define CACHE_Y(A) { YREG = ((CELL *)(A))
252 
253 #define ENDCACHE_Y() }
254 
255 #endif
256 
257 #if Y_IN_MEM
258 
259 #define CACHE_Y_AS_ENV(A) { register CELL *ENV_YREG = (A)
260 
261 #define WRITEBACK_Y_AS_ENV()   YREG = ENV_YREG
262 
263 #define ENDCACHE_Y_AS_ENV() }
264 
265 #define saveregs_and_ycache() YREG = ENV_YREG; saveregs()
266 
267 #define setregs_and_ycache() ENV_YREG = YREG; setregs()
268 
269 #else
270 
271 #define ENV_YREG (YREG)
272 
273 #define WRITEBACK_Y_AS_ENV()
274 
275 #define CACHE_Y_AS_ENV(A) { YREG = (A)
276 
277 #define ENDCACHE_Y_AS_ENV() }
278 
279 #define saveregs_and_ycache() saveregs()
280 
281 #define setregs_and_ycache() setregs()
282 
283 #endif
284 
285 #if S_IN_MEM
286 
287 #define CACHE_A1()
288 
289 #define CACHED_A1()	ARG1
290 
291 #else
292 
293 #define CACHE_A1()	(SREG = (CELL *)ARG1)
294 
295 #define CACHED_A1()	((CELL)SREG)
296 
297 #endif /* S_IN_MEM */
298 
299 /***************************************************************
300 * TR is usually, but not always, a register. This affects      *
301 * backtracking                                                 *
302 ***************************************************************/
303 
304 #define CACHE_TR(A) { register tr_fr_ptr S_TR = (A)
305 
306 #define RESTORE_TR()    TR = S_TR
307 
308 #define ENDCACHE_TR() }
309 
310 /***************************************************************
311 * S is usually, but not always, a register (X86 machines).     *
312 * This affects unification instructions                        *
313 ***************************************************************/
314 
315 #if S_IN_MEM
316 
317 /* jump through hoops because idiotic gcc will go and read S from
318    memory every time it uses S :-( */
319 
320 #define CACHE_S() { register CELL * S_SREG;
321 
322 #define ENDCACHE_S() }
323 
324 #define READ_IN_S() S_SREG = SREG
325 
326 #else
327 
328 /* do nothing if you are on a decent machine */
329 
330 #define CACHE_S() {
331 
332 #define ENDCACHE_S() }
333 
334 #define READ_IN_S()
335 
336 #define S_SREG  SREG
337 
338 #endif
339 
340 #define WRITEBACK_S(X) SREG = (X)
341 
342 /*****************************************************************
343 
344    End of Machine Dependent stuff
345 
346 ******************************************************************/
347 
348 /*****************************************************************
349 
350    Prefetch is a technique to obtain the place to jump to before actually
351    executing instructions. It can speed up some machines, by having the
352    next opcode in place before it is actually required for jumping.
353 
354 ******************************************************************/
355 
356 #if USE_THREADED_CODE
357 
358 #define DO_PREFETCH(TYPE) to_go = (void *)(NEXTOP(PREG,TYPE)->opc)
359 
360 #define DO_PREFETCH_W(TYPE) to_go = (void *)(NEXTOP(PREG,TYPE)->u.o.opcw)
361 
362 #if LIMITED_PREFETCH
363 
364 #define ALWAYS_START_PREFETCH(TYPE) \
365  { register void *to_go; DO_PREFETCH(TYPE)
366 
367 #define ALWAYS_LOOKAHEAD(WHAT) \
368  { register void *to_go = (void *)(WHAT)
369 
370 #define ALWAYS_START_PREFETCH_W(TYPE) \
371  { register void *to_go; DO_PREFETCH_W(TYPE)
372 
373 #else
374 
375 #define ALWAYS_START_PREFETCH(TYPE) {
376 
377 #define ALWAYS_START_PREFETCH_W(TYPE) {
378 
379 #define ALWAYS_LOOKAHEAD(WHERE) {
380 
381 #endif
382 
383 #ifdef USE_PREFETCH
384 
385 #define START_PREFETCH(TYPE) ALWAYS_START_PREFETCH(TYPE)
386 
387 #define START_PREFETCH_W(TYPE) ALWAYS_START_PREFETCH_W(TYPE)
388 
389 #define INIT_PREFETCH() \
390      { register void *to_go;
391 
392 #define PREFETCH_OP(X) \
393      to_go = (void *)((X)->opc);
394 
395 #else
396 
397 #define START_PREFETCH(TYPE) {
398 
399 #define START_PREFETCH_W(TYPE) {
400 
401 #define INIT_PREFETCH() {
402 
403 #define PREFETCH_OP(X)
404 
405 #endif	/* USE_PREFETCH */
406 
407 #else /* USE_THREADED_CODE */
408 
409 #define ALWAYS_START_PREFETCH(TYPE) {
410 
411 #define ALWAYS_START_PREFETCH_W(TYPE) {
412 
413 #define ALWAYS_LOOKAHEAD(WHERE) {
414 
415 #define START_PREFETCH(TYPE) {
416 
417 #define START_PREFETCH_W(TYPE) {
418 
419 #define INIT_PREFETCH() {
420 
421 #define PREFETCH_OP(X)
422 
423 #endif /* USE_THREADED_CODE */
424 
425 #define ALWAYS_END_PREFETCH() }
426 
427 #define ALWAYS_END_PREFETCH_W() }
428 
429 #define END_PREFETCH() }
430 
431 #define END_PREFETCH_W() }
432 
433 /*****************************************************************
434 
435   How to jump to the next abstract machine instruction
436 
437 ******************************************************************/
438 
439 #if USE_THREADED_CODE
440 
441 #define JMP(Lab)  goto *Lab
442 
443 #define JMPNext()						\
444 	JMP((void *)(PREG->opc))
445 
446 #define JMPNextW()						\
447 	JMP((void *)(PREG->u.o.opcw))
448 
449 #if USE_THREADED_CODE && LIMITED_PREFETCH
450 
451 #define ALWAYS_GONext() JMP(to_go)
452 
453 #define ALWAYS_GONextW() JMP(to_go)
454 
455 #else
456 
457 #define ALWAYS_GONext() JMPNext()
458 
459 #define ALWAYS_GONextW() JMPNextW()
460 
461 #endif
462 
463 #ifdef USE_PREFETCH
464 
465 #define GONext() ALWAYS_GONext()
466 
467 #define GONextW() ALWAYS_GONextW()
468 
469 #else
470 
471 #define GONext() JMPNext()
472 
473 #define GONextW() JMPNextW()
474 
475 #endif /* USE_PREFETCH */
476 
477 #define Op(Label,Type)	 Label:{ START_PREFETCH(Type)
478 
479 #define OpW(Label,Type)	 Label: { START_PREFETCH_W(Type)
480 
481 #define BOp(Label,Type)	 Label: {
482 
483 #define PBOp(Label,Type) Label: { INIT_PREFETCH()
484 
485 #define OpRW(Label,Type) Label: {
486 
487 #else /* do not use threaded code */
488 
489 #define JMPNext()	goto nextop
490 
491 #define JMPNextW()	goto nextop_write
492 
493 #define GONext()	JMPNext()
494 
495 #define GONextW()	JMPNextW()
496 
497 #define ALWAYS_GONext() GONext()
498 
499 #define ALWAYS_GONextW() GONextW()
500 
501 #define Op(Label,Type)	 case _##Label: { START_PREFETCH(Type)
502 
503 #define OpW(Label,Type)	 case  _##Label: { START_PREFETCH_W(Type)
504 
505 #define BOp(Label,Type)	 case _##Label: {
506 
507 #define PBOp(Label,Type) case _##Label: { INIT_PREFETCH()
508 
509 #define OpRW(Label,Type) case _##Label: {
510 
511 #endif
512 
513 #define ENDOp() END_PREFETCH() }
514 
515 #define ENDOpW() END_PREFETCH_W() }
516 
517 #define ENDOpRW() }
518 
519 #define ENDBOp() }
520 
521 #define ENDPBOp() END_PREFETCH() }
522 
523 /**********************************************************************
524  *                                                                    *
525  *                           PC manipulation                          *
526  *                                                                    *
527  **********************************************************************/
528 
529 /*
530  * How to set up and move a PC in a nice and disciplined way
531  *
532  */
533 
534 typedef CELL label;
535 
536 /* move PC */
537 
538 #define ADJ(P,x)    (P)+ADJUST(sizeof(x))
539 
540 /*
541  * Lookup PredEntry Structure
542  *
543  */
544 
545 #define pred_entry(X)		((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->StateOfPred))))
546 #define pred_entry_from_code(X)		((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->CodeOfPred))))
547 #define PredFromDefCode(X)	((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred))))
548 #define PredFromExpandCode(X)	((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))))
549 #define PredCode(X)		pred_entry(X)->CodeOfPred
550 #define PredOpCode(X)		pred_entry(X)->OpcodeOfPred
551 #define TruePredCode(X)		pred_entry(X)->TrueCodeOfPred
552 #define PredFunctor(X)		pred_entry(X)->FunctorOfPred
553 #define PredArity(X)		pred_entry(X)->ArityOfPE
554 #define Module(X)		pred_entry(X)->ModuleOfPred
555 
556 #define FlagOff(Mask,w) !(Mask&w)
557 #define FlagOn(Mask,w) (Mask&w)
558 #define ResetFlag(Mask,w) w &= ~Mask
559 #define SetFlag(Mask,w) w |= Mask
560 
561 /**********************************************************************
562  *                                                                    *
563  *                         X register access                          *
564  *                                                                    *
565  **********************************************************************/
566 
567 #if PRECOMPUTE_REGADDRESS
568 
569 #define XREG(I)		(*(CELL *)(I))
570 
571 #else
572 
573 #define XREG(I)		XREGS[I]
574 
575 #endif /* PRECOMPUTE_REGADDRESS */
576 
577 /* The Unification Stack is the Auxiliary stack */
578 
579 #define SP0 ((CELL *)AuxTop)
580 #define SP  AuxSp
581 
582 /**********************************************************************
583  *                                                                    *
584  *                         RWREG Manipulatio                          *
585  *                                                                    *
586  **********************************************************************/
587 
588 #define READ_MODE     1
589 #define WRITE_MODE    0
590 
591 /**********************************************************************
592  *                                                                    *
593  *Setting Temporary Copies of Often Used WAM registers for efficiency *
594  *                                                                    *
595  **********************************************************************/
596 
597 #ifdef SHADOW_P
598 #define NEEDS_TO_SET_PC 1
599 #endif
600 
601 /*
602  * First, the PC
603  */
604 #ifdef NEEDS_TO_SET_PC
605 #define set_pc()	PREG = P
606 #define save_pc()	P = PREG
607 #else
608 #define set_pc()
609 #define save_pc()
610 #define PREG            (P)
611 #endif
612 
613 /*
614  * Next, Y
615  */
616 #ifdef SHADOW_Y
617 #define set_y()		YREG = YENV
618 #define save_y()	YENV = YREG
619 #else
620 #define set_y()
621 #define save_y()
622 #define YREG            YENV
623 #endif
624 
625 /*
626  * Next, CP
627  */
628 #ifdef SHADOW_CP
629 #define set_cp()	CPREG = CP
630 #define save_cp()	CP = CPREG
631 #else
632 #define set_cp()
633 #define save_cp()
634 #define CPREG           CP
635 #endif
636 
637 /* Say which registers must be saved at register entry and register
638  * exit */
639 #define setregs()                     \
640 	set_hb();                     \
641 	set_cp();                     \
642 	set_pc();                     \
643         set_y()
644 
645 #define saveregs()                    \
646 	save_hb();                    \
647 	save_cp();                    \
648 	save_pc();                    \
649         save_y()
650 
651 #if BP_FREE
652 /* if we are using BP as a local register, we must save it whenever we leave absmi.c */
653 #define always_save_pc()          save_pc()
654 #define always_set_pc()           set_pc()
655 #else
656 #define always_save_pc()
657 #define always_set_pc()
658 #endif /* BP_FREE */
659 
660 /************************************************************
661 
662 Macros to check the limits of stacks
663 
664 *************************************************************/
665 
666 #if HAVE_SIGSEGV
667 /* for the moment I don't know how to handle trail overflows
668    in a pure Windows environment
669 */
670 #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(THREADS) && !defined(YAPOR) && !defined(USE_SYSTEM_MALLOC) && !USE_DL_MALLOC
671 #define OS_HANDLES_TR_OVERFLOW 1
672 #endif
673 #endif
674 
675 #ifdef OS_HANDLES_TR_OVERFLOW
676 
677 #define check_trail(x)
678 
679 #define check_trail_in_indexing(x)
680 
681 #else
682 
683 #define check_trail(x) if (Unsigned(Yap_TrailTop) - Unsigned(x) < MinTrailGap) \
684 			goto notrailleft
685 
686 #define check_trail_in_indexing(x) if (Unsigned(Yap_TrailTop) - Unsigned(x) < MinTrailGap) \
687 			goto notrailleft_from_index
688 
689 #endif
690 
691 #if (defined(SBA) && defined(YAPOR)) || defined(TABLING)
692 #define check_stack(Label, GLOB)                             \
693  if ( (Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CreepFlag  ) goto Label
694 #else
695 #define check_stack(Label, GLOB)                             \
696  if ( (Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CreepFlag ) goto Label
697 #endif /* SBA && YAPOR */
698 
699 /***************************************************************
700 * Macros for choice point manipulation                         *
701 ***************************************************************/
702 
703 /***************************************************************
704 * Store variable number of arguments in a choice point         *
705 ***************************************************************/
706 /***
707    pt1 points at the new choice point,
708    pt0 points at XREGS[i]
709    d0 is a counter
710    The macro just pushes the arguments one by one to the local stack.
711 ***/
712 #define store_args(arity)                                         \
713                  BEGP(pt0);                                       \
714 		 pt0 = XREGS+(arity);                             \
715 		 while ( pt0 > XREGS )                            \
716                    { register CELL x = pt0[0];                    \
717                      S_YREG = S_YREG-1;			          \
718                      --pt0;                                       \
719                      (S_YREG)[0] = x;	                          \
720 		   }                                              \
721                  ENDP(pt0)
722 
723 #define store_at_least_one_arg(arity)                             \
724                  BEGP(pt0);                                       \
725 		 pt0 = XREGS+(arity);                             \
726                  do { register CELL x = pt0[0];                   \
727                      S_YREG = (S_YREG)-1;			          \
728                      --pt0;                                       \
729                      (S_YREG)[0] = x;	                          \
730 		   }                                              \
731 		 while ( pt0 > XREGS );                           \
732                  ENDP(pt0)
733 
734 #if LOW_LEVEL_TRACER
735 #define COUNT_CPS() Yap_total_choicepoints++
736 #else
737 #define COUNT_CPS()
738 #endif
739 
740 /***************************************************************
741 * Do the bulk of work in creating a choice-point               *
742 * AP: alternative pointer                                      *
743 ***************************************************************/
744 /*
745  * The macro just sets pt1 to point to the base of the choicepoint
746  * and then fills in all the necessary fields
747  */
748 #ifdef DEPTH_LIMIT
749 #define store_yaam_reg_cpdepth(CPTR) (CPTR)->cp_depth = DEPTH
750 #else
751 #define store_yaam_reg_cpdepth(CPTR)
752 #endif
753 
754 #define store_yaam_regs(AP,I) \
755                  { /* Jump to CP_BASE */                         \
756 		   COUNT_CPS();					       \
757                    S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1);     \
758                    /* Save Information */                        \
759 		   HBREG = H;                                    \
760                    B_YREG->cp_tr = TR;				 \
761                    B_YREG->cp_h  = H;				 \
762                    B_YREG->cp_b  = B;				 \
763                    store_yaam_reg_cpdepth(B_YREG);               \
764                    B_YREG->cp_cp = CPREG;			 \
765                    B_YREG->cp_ap = AP;				 \
766                    B_YREG->cp_env= ENV;				 \
767                  }
768 
769 #define store_yaam_regs_for_either(AP,d0) \
770                 COUNT_CPS();					 \
771                  pt1 --; /* Jump to CP_BASE */		         \
772                  /* Save Information */                          \
773 		 HBREG = H;                                      \
774                  pt1->cp_tr = TR;	                         \
775                  pt1->cp_h = H;		                         \
776 		 pt1->cp_b = B;		                         \
777                  store_yaam_reg_cpdepth(pt1);                    \
778                  pt1->cp_cp = d0;                                \
779                  pt1->cp_ap = AP;                                \
780 		 pt1->cp_env = ENV;
781 
782 /***************************************************************
783 * Place B as the new place to cut to                           *
784 ***************************************************************/
785 #define	  set_cut(E,B) (E)[E_CB] = (CELL)(B)
786 
787 /***************************************************************
788 * Restore WAM registers from a choice point                    *
789 ***************************************************************/
790 
791 #ifdef DEPTH_LIMIT
792 #define restore_yaam_reg_cpdepth(CPTR) DEPTH = (CPTR)->cp_depth
793 #else
794 #define restore_yaam_reg_cpdepth(CPTR)
795 #endif
796 
797 #ifdef YAPOR
798 #define YAPOR_update_alternative(CUR_ALT, NEW_ALT)  \
799 	  if (SCH_top_shared_cp(B)) {               \
800 	    SCH_new_alternative(CUR_ALT, NEW_ALT);  \
801 	  } else
802 #else
803 #define YAPOR_update_alternative(CUR_ALT, NEW_ALT)
804 #endif /* YAPOR */
805 
806 #if defined(FROZEN_STACKS) && !defined(BFZ_TRAIL_SCHEME)
807 #define SET_BB(V)    BBREG = (V)
808 #else
809 #define SET_BB(V)
810 #endif /* FROZEN_STACKS && !BFZ_TRAIL_SCHEME */
811 
812 
813 #ifdef FROZEN_STACKS
814 #ifdef SBA
815 #define PROTECT_FROZEN_H(CPTR)                                  \
816        ((Unsigned((Int)((CPTR)->cp_h)-(Int)(H_FZ)) <            \
817 	 Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ?                   \
818 	(CPTR)->cp_h : H_FZ)
819 #define PROTECT_FROZEN_B(CPTR)                                  \
820        ((Unsigned((Int)(CPTR)-(Int)(H_FZ)) <                    \
821 	 Unsigned((Int)(B_FZ)-(Int)(H_FZ)))  ?                  \
822 	(CPTR) : B_FZ)
823 	 /*
824 #define PROTECT_FROZEN_H(CPTR) ((CPTR)->cp_h > H_FZ && (CPTR)->cp_h < (CELL *)B_FZ ? (CPTR)->cp_h : H_FZ )
825 
826 #define PROTECT_FROZEN_B(CPTR)  ((CPTR) < B_FZ && (CPTR) > (choiceptr)H_FZ ? (CPTR) : B_FZ )
827 	 */
828 #else /* TABLING */
829 #define PROTECT_FROZEN_B(CPTR)  (YOUNGER_CP(CPTR, B_FZ) ? CPTR        : B_FZ)
830 #define PROTECT_FROZEN_H(CPTR)  (((CPTR)->cp_h > H_FZ) ? (CPTR)->cp_h : H_FZ)
831 #endif /* SBA */
832 #else
833 #define PROTECT_FROZEN_B(CPTR)  (CPTR)
834 #define PROTECT_FROZEN_H(CPTR)  (CPTR)->cp_h
835 #endif /* FROZEN_STACKS */
836 
837 #define restore_yaam_regs(AP)                                    \
838                  { register CELL *x1 = B_YREG->cp_env;	         \
839                    register yamop *x2;				 \
840                    H = HBREG = PROTECT_FROZEN_H(B_YREG);            \
841 		   restore_yaam_reg_cpdepth(B_YREG);	         \
842                    CPREG  = B_YREG->cp_cp;		                 \
843 		   /* AP may depend on H */			 \
844 		   x2 = (yamop *)AP;		                 \
845                    ENV    = x1;                                  \
846                    YAPOR_update_alternative(PREG, x2)            \
847                    B_YREG->cp_ap = x2;                              \
848                  }
849 
850 /***************************************************************
851 * Restore variable number of arguments from a choice point     *
852 ***************************************************************/
853 #define restore_args(Nargs)                                        \
854                  BEGD(d0);                                         \
855                  d0 = Nargs;                                       \
856                  BEGP(pt0);                                        \
857                  BEGP(pt1);                                        \
858                  pt1 = (CELL *)(B_YREG+1)+d0;                         \
859                  pt0 = XREGS+1+d0;                                 \
860 	         while (pt0 > XREGS +1 )                           \
861                    { register CELL x = pt1[-1];                    \
862                      --pt0;                                        \
863                      --pt1;                                        \
864                      *pt0   = x;                                   \
865 		   }                                               \
866                  ENDP(pt1);                                        \
867                  ENDP(pt0);                                        \
868                  ENDD(d0)
869 
870 #define restore_at_least_one_arg(Nargs)                            \
871                  BEGD(d0);                                         \
872                  d0 = Nargs;                                       \
873                  BEGP(pt0);                                        \
874                  BEGP(pt1);                                        \
875                  pt1 = (CELL *)(B_YREG+1)+d0;                         \
876                  pt0 = XREGS+1+d0;                                 \
877                  do { register CELL x = pt1[-1];                   \
878                      --pt0;                                        \
879                      --pt1;                                        \
880                      *pt0   = x;                                   \
881 		   }                                               \
882 	         while (pt0 > XREGS +1 );                          \
883                  ENDP(pt1);                                        \
884                  ENDP(pt0);                                        \
885                  ENDD(d0)
886 
887 /***************************************************************
888 * Execute trust to release YAAM registers and pop choice point *
889 ***************************************************************/
890 #ifdef DEPTH_LIMIT
891 #define pop_yaam_reg_cpdepth(CPTR) DEPTH = (CPTR)->cp_depth
892 #else
893 #define pop_yaam_reg_cpdepth(CPTR)
894 #endif
895 
896 #ifdef TABLING
897 #define TABLING_close_alt(CPTR) (CPTR)->cp_ap = NULL
898 #else
899 #define TABLING_close_alt(CPTR)
900 #endif /* TABLING */
901 
902 #define pop_yaam_regs()                                           \
903                  {                                                \
904                    H = PROTECT_FROZEN_H(B_YREG);                  \
905 		   B = B_YREG->cp_b;	                          \
906                    pop_yaam_reg_cpdepth(B_YREG);                  \
907 		   CPREG = B_YREG->cp_cp;		          \
908 		   ENV = B_YREG->cp_env;			  \
909                    TABLING_close_alt(B_YREG);	                  \
910                    HBREG = PROTECT_FROZEN_H(B);		          \
911                  }
912 
913 #define pop_args(NArgs)                                           \
914                  BEGD(d0);                                        \
915                  d0 = (NArgs);                                    \
916                  BEGP(pt0);                                       \
917                  BEGP(pt1);                                       \
918                  S_YREG = (CELL *)(B_YREG+1);                     \
919                  pt0 = XREGS + 1 ;                                \
920                  pt1 = S_YREG ;                                   \
921 		 while (pt0 < XREGS+1+d0)                         \
922                    { register CELL x = pt1[0];                    \
923                      pt1++;                                       \
924                      pt0++;                                       \
925                      pt0[-1] = x;                                 \
926 		   }                                              \
927                  S_YREG = pt1;					  \
928                  ENDP(pt1);                                       \
929                  ENDP(pt0);                                       \
930                  ENDD(d0);
931 
932 #define pop_at_least_one_arg(NArgs)                               \
933                  BEGD(d0);                                        \
934                  d0 = (NArgs);                                    \
935                  BEGP(pt0);                                       \
936                  BEGP(pt1);                                       \
937                  pt1 = (CELL *)(B_YREG+1);                        \
938                  pt0 = XREGS + 1 ;                                \
939                  do { register CELL x = pt1[0];                   \
940                      pt1++;                                       \
941                      pt0++;                                       \
942                      pt0[-1] = x;                                 \
943 		   }                                              \
944 		 while (pt0 < XREGS+1+d0);                        \
945                  S_YREG = pt1;	                                  \
946                  ENDP(pt1);                                       \
947                  ENDP(pt0);                                       \
948                  ENDD(d0);
949 
950 /**********************************************************************
951  *                                                                    *
952  *                    failure and backtracking                        *
953  *                                                                    *
954  **********************************************************************/
955 
956 /* Failure can be called from two routines.
957  *
958  * If from within the emulator, we should jump to the label fail.
959  *
960  * If from within the complex-term unification routine, we should jump
961  * to the label "cufail".
962  *
963  */
964 
965 #define FAIL()	goto fail
966 
967 /**********************************************************************
968  *                                                                    *
969  *                      unification routines                          *
970  *                                                                    *
971  **********************************************************************/
972 
973 #ifdef COROUTINING
974 #define UnifyCells(a, b, l1, l2)                                  \
975      if((a) > (b)) {                                              \
976 	if ((a)<=H) { BIND_GLOBAL((a),(CELL)(b),l1); }            \
977 	else if ((b)<= H) { Bind_Local((a),(CELL)(b)); goto l1;}  \
978 	else { Bind_Local((b),(CELL) (a));  goto l1;}             \
979      } else if((a) < (b)){                                        \
980 	if((b) <= H) { BIND_GLOBAL2((b),(CELL) (a),l2,l1); }      \
981 	else if ((a) <= H) { Bind_Local((b),(CELL) (a));  goto l1;} \
982 	else { Bind_Local((a),(CELL) (b));  goto l1;}             \
983      } else goto l1;
984 
985 /* I know (a) <= H */
986 #define UnifyGlobalRegCells(a, b, l1, l2)                         \
987      if((a) > (b)) {                                              \
988 	BIND_GLOBAL((a),(CELL)(b),l1);                            \
989      } else if((a) < (b)){                                        \
990 	if((b) <= H) { BIND_GLOBAL2((b),(CELL) (a),l2,l1); }      \
991 	Bind_Local((b),(CELL) (a));                               \
992 	goto l1;				                  \
993      } else goto l1;
994 
995 #else
996 #define UnifyCells(a, b, l1, l2)                                  \
997      if((a) > (b)) {                                              \
998 	if ((a)<=H) { BIND_GLOBAL((a),(CELL)(b),l1); }            \
999 	else if ((b)<= H) { Bind_Local((a),(CELL)(b)); }          \
1000 	else { Bind_Local((b),(CELL) (a)); }                      \
1001      } else if((a) < (b)){                                        \
1002 	if((b) <= H) { BIND_GLOBAL2((b),(CELL) (a),l2,l1); }      \
1003 	else if ((a) <= H) { Bind_Local((b),(CELL) (a)); }        \
1004 	else { Bind_Local((a),(CELL) (b)); }                      \
1005      }
1006 
1007 /* I know (a) <= H */
1008 #define UnifyGlobalRegCells(a, b, l1, l2)                         \
1009      if((a) > (b)) {                                              \
1010 	BIND_GLOBAL((a),(CELL)(b),l1);                            \
1011      } else if((a) < (b)){                                        \
1012 	if((b) <= H) { BIND_GLOBAL2((b),(CELL) (a),l2,l1); }      \
1013 	Bind_Local((b),(CELL) (a));                               \
1014      }
1015 
1016 #endif
1017 
1018 #define UnifyGlobalCells(a, b)                                    \
1019      if((a) > (b)) {                                              \
1020 	BIND_GLOBALCELL((a),(CELL)(b));                           \
1021      } else if((a) < (b)){                                        \
1022 	BIND_GLOBALCELL((b),(CELL) (a));                          \
1023      }
1024 
1025 /* unify two complex terms.
1026  *
1027  * I use two stacks: one keeps the visited terms, and the other keeps the
1028  * terms to visit.
1029  *
1030  * The terms-to-visit stack is used to implement traditional
1031  * recursion. The visited-terms-stack is used to link structures already
1032  * visited and allows unification of infinite terms
1033  *
1034  */
1035 
1036 #ifdef RATIONAL_TREES
1037 
1038 #define UNWIND_CUNIF()                                        \
1039          while (visited < AuxSp) {                            \
1040             pt1 = (CELL *)visited[0];                         \
1041             *pt1 = visited[1];                                \
1042             visited += 2;                                     \
1043          }
1044 
1045 #else
1046 #define UNWIND_CUNIF()
1047 #endif
1048 
1049 #define UnifyBound_TEST_ATTACHED(f,d0,pt0,d1)                          \
1050  if (IsExtensionFunctor(f)) {                                          \
1051    if (unify_extension(f, d0, RepAppl(d0), d1))                        \
1052         { GONext(); }                                                  \
1053       else                                                             \
1054         { FAIL(); }                                                    \
1055     }
1056 
1057 
1058 #define UnifyBound(d0,d1)                                              \
1059   if (d0 == d1) GONext();                                              \
1060   if (IsPairTerm(d0)) {                                                \
1061     register CELL *ipt0, *ipt1;                                        \
1062     if (!IsPairTerm(d1)) { FAIL(); }                                   \
1063     ipt0 = RepPair(d0);                                                \
1064     ipt1 = RepPair(d1);                                                \
1065     save_hb();							       \
1066     always_save_pc();						       \
1067     if (IUnify_complex(ipt0-1,ipt0+1,ipt1-1)) {always_set_pc(); GONext();}\
1068     else { FAIL(); }                                                   \
1069   } else if (IsApplTerm(d0)) {                                         \
1070     register CELL *ipt0, *ipt1;                                        \
1071     register Functor f;                                                \
1072     if (!IsApplTerm(d1)) { FAIL(); }                                   \
1073     ipt0 = RepAppl(d0);                                                \
1074     ipt1 = RepAppl(d1);                                                \
1075     f = (Functor)*ipt0;                                                \
1076     if (f != (Functor)*ipt1) { FAIL(); }                               \
1077     UnifyBound_TEST_ATTACHED(f,d0,ipt0,d1);                            \
1078     d0 = ArityOfFunctor(f);                                            \
1079     always_save_pc();						       \
1080     save_hb();							       \
1081     if (IUnify_complex(ipt0, ipt0+d0, ipt1)) {always_set_pc(); GONext();} \
1082     else { FAIL(); }                                                   \
1083   }                                                                    \
1084   else { FAIL(); }
1085 
1086 
1087 /*
1088  * Next, HB
1089  */
1090 #ifdef SHADOW_HB
1091 #undef HBREG
1092 #define set_hb()	HBREG = HB
1093 #define save_hb()	HB = HBREG
1094 #else
1095 #define set_hb()
1096 #define save_hb()
1097 #endif
1098 
1099 typedef struct unif_record {
1100   CELL *ptr;
1101   Term old;
1102 } unif_record;
1103 
1104 typedef struct v_record {
1105   CELL *start0;
1106   CELL *end0;
1107   CELL *start1;
1108   Term old;
1109 } v_record;
1110 
1111 #if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)
1112 
1113 static int
IUnify_complex(CELL * pt0,CELL * pt0_end,CELL * pt1)1114 IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
1115 {
1116 #ifdef THREADS
1117 #undef Yap_REGS
1118   register REGSTORE *regp = Yap_regp;
1119 #define Yap_REGS (*regp)
1120 #elif defined(SHADOW_REGS)
1121 #if defined(B) || defined(TR)
1122   register REGSTORE *regp = &Yap_REGS;
1123 
1124 #define Yap_REGS (*regp)
1125 #endif /* defined(B) || defined(TR) || defined(HB) */
1126 #endif
1127 
1128 #ifdef SHADOW_HB
1129   register CELL *HBREG = HB;
1130 #endif /* SHADOW_HB */
1131 
1132   struct unif_record  *unif = (struct unif_record *)AuxBase;
1133   struct v_record *to_visit  = (struct v_record *)AuxSp;
1134 #define unif_base ((struct unif_record *)AuxBase)
1135 #define to_visit_base ((struct v_record *)AuxSp)
1136 
1137 loop:
1138   while (pt0 < pt0_end) {
1139     register CELL *ptd0 = pt0+1;
1140     register CELL d0;
1141 
1142     ++pt1;
1143     pt0 = ptd0;
1144     d0 = *ptd0;
1145     deref_head(d0, unify_comp_unk);
1146   unify_comp_nvar:
1147     {
1148       register CELL *ptd1 = pt1;
1149       register CELL d1 = *ptd1;
1150 
1151       deref_head(d1, unify_comp_nvar_unk);
1152     unify_comp_nvar_nvar:
1153       if (d0 == d1)
1154 	continue;
1155       if (IsPairTerm(d0)) {
1156 	if (!IsPairTerm(d1)) {
1157 	  goto cufail;
1158 	}
1159 	/* now link the two structures so that no one else will */
1160 	/* come here */
1161 	/* store the terms to visit */
1162 	if (RATIONAL_TREES || pt0 < pt0_end) {
1163 	  to_visit --;
1164 #ifdef RATIONAL_TREES
1165 	  unif++;
1166 #endif
1167 	  if ((void *)to_visit < (void *)unif) {
1168 	    CELL **urec = (CELL **)unif;
1169 	    to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec);
1170 	    unif = (struct unif_record *)urec;
1171 	  }
1172 	  to_visit->start0 = pt0;
1173 	  to_visit->end0 = pt0_end;
1174 	  to_visit->start1 = pt1;
1175 #ifdef RATIONAL_TREES
1176 	  unif[-1].old = *pt0;
1177 	  unif[-1].ptr = pt0;
1178 	  *pt0 = d1;
1179 #endif
1180 	}
1181 	pt0_end = (pt0 = RepPair(d0) - 1) + 2;
1182 	pt1 = RepPair(d1) - 1;
1183 	continue;
1184       }
1185       if (IsApplTerm(d0)) {
1186 	register Functor f;
1187 	register CELL *ap2, *ap3;
1188 
1189 	if (!IsApplTerm(d1)) {
1190 	  goto cufail;
1191 	}
1192 	/* store the terms to visit */
1193 	ap2 = RepAppl(d0);
1194 	ap3 = RepAppl(d1);
1195 	f = (Functor) (*ap2);
1196 	/* compare functors */
1197 	if (f != (Functor) *ap3)
1198 	  goto cufail;
1199 	if (IsExtensionFunctor(f)) {
1200 	  if (unify_extension(f, d0, ap2, d1))
1201 	    continue;
1202 	  goto cufail;
1203 	}
1204 	/* now link the two structures so that no one else will */
1205 	/* come here */
1206 	/* store the terms to visit */
1207 	if (RATIONAL_TREES || pt0 < pt0_end) {
1208 	  to_visit --;
1209 #ifdef RATIONAL_TREES
1210 	  unif++;
1211 #endif
1212 	  if ((void *)to_visit < (void *)unif) {
1213 	    CELL **urec = (CELL **)unif;
1214 	    to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec);
1215 	    unif = (struct unif_record *)urec;
1216 	  }
1217 	  to_visit->start0 = pt0;
1218 	  to_visit->end0 = pt0_end;
1219 	  to_visit->start1 = pt1;
1220 #ifdef RATIONAL_TREES
1221 	  unif[-1].old = *pt0;
1222 	  unif[-1].ptr = pt0;
1223 	  *pt0 = d1;
1224 #endif
1225 	}
1226 	d0 = ArityOfFunctor(f);
1227 	pt0 = ap2;
1228 	pt0_end = ap2 + d0;
1229 	pt1 = ap3;
1230 	continue;
1231       }
1232       goto cufail;
1233 
1234       derefa_body(d1, ptd1, unify_comp_nvar_unk, unify_comp_nvar_nvar);
1235 	/* d1 and pt2 have the unbound value, whereas d0 is bound */
1236       BIND_GLOBALCELL(ptd1, d0);
1237     }
1238 
1239     derefa_body(d0, ptd0, unify_comp_unk, unify_comp_nvar);
1240     /* first arg var */
1241     {
1242       register CELL d1;
1243       register CELL *ptd1;
1244 
1245       ptd1 = pt1;
1246       d1 = ptd1[0];
1247       /* pt2 is unbound */
1248       deref_head(d1, unify_comp_var_unk);
1249     unify_comp_var_nvar:
1250       /* pt2 is unbound and d1 is bound */
1251       BIND_GLOBALCELL(ptd0, d1);
1252 
1253       derefa_body(d1, ptd1, unify_comp_var_unk, unify_comp_var_nvar);
1254       /* ptd0 and ptd1 are unbound */
1255       UnifyGlobalCells(ptd0, ptd1);
1256     }
1257   }
1258   /* Do we still have compound terms to visit */
1259   if (to_visit < to_visit_base) {
1260     pt0 = to_visit->start0;
1261     pt0_end = to_visit->end0;
1262     pt1 = to_visit->start1;
1263     to_visit++;
1264     goto loop;
1265   }
1266 #ifdef RATIONAL_TREES
1267   /* restore bindigs */
1268   while (unif-- != unif_base) {
1269     CELL *pt0;
1270 
1271     pt0 = unif->ptr;
1272     *pt0 = unif->old;
1273   }
1274 #endif
1275   return TRUE;
1276 
1277 cufail:
1278 #ifdef RATIONAL_TREES
1279   /* restore bindigs */
1280   while (unif-- != unif_base) {
1281     CELL *pt0;
1282 
1283     pt0 = unif->ptr;
1284     *pt0 = unif->old;
1285   }
1286 #endif
1287   return FALSE;
1288 #ifdef THREADS
1289 #undef Yap_REGS
1290 #define Yap_REGS (*Yap_regp)
1291 #elif defined(SHADOW_REGS)
1292 #if defined(B) || defined(TR)
1293 #undef Yap_REGS
1294 #endif /* defined(B) || defined(TR) */
1295 #endif
1296 }
1297 
1298 /*  don't pollute name space */
1299 #undef to_visit_base
1300 #undef unif_base
1301 
1302 
1303 #endif
1304 
1305 
1306 #if defined(IN_ABSMI_C) || defined(IN_INLINES_C)
1307 
1308 static int
iequ_complex(register CELL * pt0,register CELL * pt0_end,register CELL * pt1)1309 iequ_complex(register CELL *pt0, register CELL *pt0_end,
1310 	       register CELL *pt1
1311 )
1312 {
1313 #ifdef THREADS
1314 #undef Yap_REGS
1315   register REGSTORE *regp = Yap_regp;
1316 #define Yap_REGS (*regp)
1317 #elif defined(SHADOW_REGS)
1318 #if defined(B) || defined(TR)
1319   register REGSTORE *regp = &Yap_REGS;
1320 
1321 #define Yap_REGS (*regp)
1322 #endif /* defined(B) || defined(TR) || defined(HB) */
1323 #endif
1324 
1325 #ifdef SHADOW_HB
1326   register CELL *HBREG = HB;
1327 #endif /* SHADOW_HB */
1328 
1329   struct unif_record  *unif = (struct unif_record *)AuxBase;
1330   struct v_record *to_visit  = (struct v_record *)AuxSp;
1331 #define unif_base ((struct unif_record *)AuxBase)
1332 #define to_visit_base ((struct v_record *)AuxSp)
1333 
1334 loop:
1335   while (pt0 < pt0_end) {
1336     register CELL *ptd0 = pt0+1;
1337     register CELL d0;
1338 
1339     ++pt1;
1340     pt0 = ptd0;
1341     d0 = *ptd0;
1342     deref_head(d0, iequ_comp_unk);
1343   iequ_comp_nvar:
1344     {
1345       register CELL *ptd1 = pt1;
1346       register CELL d1 = *ptd1;
1347 
1348       deref_head(d1, iequ_comp_nvar_unk);
1349     iequ_comp_nvar_nvar:
1350       if (d0 == d1)
1351 	continue;
1352       if (IsPairTerm(d0)) {
1353 	if (!IsPairTerm(d1)) {
1354 	  goto cufail;
1355 	}
1356 	/* now link the two structures so that no one else will */
1357 	/* come here */
1358 	/* store the terms to visit */
1359 	if (RATIONAL_TREES || pt0 < pt0_end) {
1360 	  to_visit --;
1361 #ifdef RATIONAL_TREES
1362 	  unif++;
1363 #endif
1364 	  if ((void *)to_visit < (void *)unif) {
1365 	    CELL **urec = (CELL **)unif;
1366 	    to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec);
1367 	    unif = (struct unif_record *)urec;
1368 	  }
1369 	  to_visit->start0 = pt0;
1370 	  to_visit->end0 = pt0_end;
1371 	  to_visit->start1 = pt1;
1372 #ifdef RATIONAL_TREES
1373 	  unif[-1].old = *pt0;
1374 	  unif[-1].ptr = pt0;
1375 	  *pt0 = d1;
1376 #endif
1377 	}
1378 	pt0_end = (pt0 = RepPair(d0) - 1) + 2;
1379 	pt1 = RepPair(d1) - 1;
1380 	continue;
1381       }
1382       if (IsApplTerm(d0)) {
1383 	register Functor f;
1384 	register CELL *ap2, *ap3;
1385 
1386 	if (!IsApplTerm(d1)) {
1387 	  goto cufail;
1388 	}
1389 	/* store the terms to visit */
1390 	ap2 = RepAppl(d0);
1391 	ap3 = RepAppl(d1);
1392 	f = (Functor) (*ap2);
1393 	/* compare functors */
1394 	if (f != (Functor) *ap3)
1395 	  goto cufail;
1396 	if (IsExtensionFunctor(f)) {
1397 	  if (unify_extension(f, d0, ap2, d1))
1398 	    continue;
1399 	  goto cufail;
1400 	}
1401 	/* now link the two structures so that no one else will */
1402 	/* come here */
1403 	/* store the terms to visit */
1404 	if (RATIONAL_TREES || pt0 < pt0_end) {
1405 	  to_visit --;
1406 #ifdef RATIONAL_TREES
1407 	  unif++;
1408 #endif
1409 	  if ((void *)to_visit < (void *)unif) {
1410 	    CELL **urec = (CELL **)unif;
1411 	    to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec);
1412 	    unif = (struct unif_record *)urec;
1413 	  }
1414 	  to_visit->start0 = pt0;
1415 	  to_visit->end0 = pt0_end;
1416 	  to_visit->start1 = pt1;
1417 #ifdef RATIONAL_TREES
1418 	  unif[-1].old = *pt0;
1419 	  unif[-1].ptr = pt0;
1420 	  *pt0 = d1;
1421 #endif
1422 	}
1423 	d0 = ArityOfFunctor(f);
1424 	pt0 = ap2;
1425 	pt0_end = ap2 + d0;
1426 	pt1 = ap3;
1427 	continue;
1428       }
1429       goto cufail;
1430 
1431       derefa_body(d1, ptd1, iequ_comp_nvar_unk, iequ_comp_nvar_nvar);
1432 	/* d1 and pt2 have the unbound value, whereas d0 is bound */
1433       goto cufail;
1434 
1435     }
1436 
1437     derefa_body(d0, ptd0, iequ_comp_unk, iequ_comp_nvar);
1438     /* first arg var */
1439     {
1440       register CELL d1;
1441       register CELL *ptd1;
1442 
1443       ptd1 = pt1;
1444       d1 = ptd1[0];
1445       /* pt2 is unbound */
1446       deref_head(d1, iequ_comp_var_unk);
1447     iequ_comp_var_nvar:
1448       /* pt2 is unbound and d1 is bound */
1449       goto cufail;
1450 
1451       derefa_body(d1, ptd1, iequ_comp_var_unk, iequ_comp_var_nvar);
1452       /* pt2 and pt3 are unbound */
1453       if (ptd0 == ptd1)
1454 	continue;
1455       goto cufail;
1456 
1457     }
1458   }
1459   /* Do we still have compound terms to visit */
1460   if (to_visit < to_visit_base) {
1461     pt0 = to_visit->start0;
1462     pt0_end = to_visit->end0;
1463     pt1 = to_visit->start1;
1464     to_visit++;
1465     goto loop;
1466   }
1467 #ifdef RATIONAL_TREES
1468   /* restore bindigs */
1469   while (unif-- != unif_base) {
1470     CELL *pt0;
1471 
1472     pt0 = unif->ptr;
1473     *pt0 = unif->old;
1474   }
1475 #endif
1476   return TRUE;
1477 
1478 cufail:
1479 #ifdef RATIONAL_TREES
1480   /* restore bindigs */
1481   while (unif-- != unif_base) {
1482     CELL *pt0;
1483 
1484     pt0 = unif->ptr;
1485     *pt0 = unif->old;
1486   }
1487 #endif
1488   return FALSE;
1489 #ifdef THREADS
1490 #undef Yap_REGS
1491 #define Yap_REGS (*Yap_regp)
1492 #elif defined(SHADOW_REGS)
1493 #if defined(B) || defined(TR)
1494 #undef Yap_REGS
1495 #endif /* defined(B) || defined(TR) */
1496 #endif
1497 }
1498 
1499 #endif
1500 
1501 static inline wamreg
Yap_regnotoreg(UInt regnbr)1502 Yap_regnotoreg(UInt regnbr)
1503 {
1504 #if PRECOMPUTE_REGADDRESS
1505   return (wamreg)(XREGS + regnbr);
1506 #else
1507 #if MSHIFTOFFS
1508   return regnbr;
1509 #else
1510   return CELLSIZE*regnbr;
1511 #endif
1512 #endif /* ALIGN_LONGS */
1513 }
1514 
1515 static inline UInt
Yap_regtoregno(wamreg reg)1516 Yap_regtoregno(wamreg reg)
1517 {
1518 #if PRECOMPUTE_REGADDRESS
1519   return ((CELL *)reg)-XREGS;
1520 #else
1521 #if MSHIFTOFFS
1522   return reg;
1523 #else
1524   return reg/CELLSIZE;
1525 #endif
1526 #endif /* ALIGN_LONGS */
1527 }
1528 
1529 #ifdef DEPTH_LIMIT
1530 #define check_depth(DEPTH, ap) \
1531 	  if ((DEPTH) <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ \
1532 	    if ((ap)->ModuleOfPred) {\
1533 	      if ((DEPTH) == MkIntTerm(0))\
1534 		FAIL(); \
1535 	      else (DEPTH) = RESET_DEPTH();\
1536 	    } \
1537 	  } else if ((ap)->ModuleOfPred)\
1538 	    (DEPTH) -= MkIntConstant(2);
1539 #else
1540 #define check_depth(DEPTH, ap)
1541 #endif
1542 
1543 #if defined(THREADS) || defined(YAPOR)
1544 #define copy_jmp_address(X) (PREG_ADDR = &(X))
1545 #define copy_jmp_addressa(X) (PREG_ADDR = (yamop **)(X))
1546 #else
1547 #define copy_jmp_address(X)
1548 #define copy_jmp_addressa(X)
1549 #endif
1550 
1551