YAP 7.1.0
absmi.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: absmi.h *
12 * Last rev: *
13 * mods: *
14 * comments: Portable abstract machine interpreter includes *
15 * *
16 *************************************************************************/
17
18
19#ifndef ABSMI_H
20
21#define ABSMI_H 1
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#ifdef __cplusplus
32#define register
33#endif
34
35
36#if TABLING
37#define FROZEN_STACKS 1
38//#define MULTIPLE_STACKS 1
39#endif
40
41/***************************************************************
42 * Macros for register manipulation *
43 ***************************************************************/
44/*
45 * Machine and compiler dependent definitions
46 */
47#if 1 //def __GNUC__
48
49#ifdef hppa
50#define SHADOW_P 1
51#define SHADOW_Y 1
52#define SHADOW_REGS 1
53#define USE_PREFETCH 1
54#endif
55
56#ifdef __alpha
57#define SHADOW_P 1
58#define SHADOW_Y 1
59#define SHADOW_REGS 1
60#define USE_PREFETCH 1
61#elif defined(_POWER) || defined(__POWERPC__)
62#define SHADOW_P 1
63#define SHADOW_REGS 1
64#define USE_PREFETCH 1
65#elif defined(__x86_64__)
66#define SHADOW_P 1
67#ifdef BP_FREE
68#undef BP_FREE
69#endif
70#undef SHADOW_S
71//#define SHADOW_Y 1
72#define S_IN_MEM 1
73#define Y_IN_MEM 1
74#define TR_IN_MEM 1
75#define LIMITED_PREFETCH 1
76
77#elif defined(__i386__)
78#undef SHADOW_S
79
80#define Y_IN_MEM 1
81#define S_IN_MEM 1
82#define TR_IN_MEM 1
83#define HAVE_FEW_REGS 1
84#define LIMITED_PREFETCH 1
85
86#ifdef BP_FREE
87/***************************************************************
88 * Use bp as PREG for X86 machines *
89 ***************************************************************/
90#if defined(IN_ABSMI_C)
91register struct yami *P1REG asm("bp"); /* can't use yamop before Yap.h */
92#define PREG P1REG
93#endif
94#define NEEDS_TO_SET_PC 1
95#endif /* BP_FREE */
96#endif /* i386 */
97
98#ifdef sparc
99#define SHADOW_P 1
100#ifdef BP_FREE
101#undef BP_FREE
102#endif
103#define S_IN_MEM 1
104#define Y_IN_MEM 1
105#define TR_IN_MEM 1
106#endif /* sparc_ */
107
108
109#if defined(__arm__) || defined(__thumb__) || defined(mips) || \
110 defined(__mips64) || defined(__arch64__)
111
112#define Y_IN_MEM 1
113#define S_IN_MEM 1
114#define TR_IN_MEM 1
115#define HAVE_FEW_REGS 1
116#endif
117
118#else /* other compilers */
119
120#define S_IN_MEM 1
121
122/* This works for xlc under AIX 3.2.5 */
123#ifdef _IBMR2
124#define SHADOW_P 1
125#define SHADOW_REGS 1
126#define SHADOW_S 1
127#endif
128
129#if defined(__x86_64__)
130#define Y_IN_MEM 1
131#define TR_IN_MEM 1
132#elif defined(i386)
133#define Y_IN_MEM 1
134#define TR_IN_MEM 1
135#define HAVE_FEW_REGS 1
136#endif
137
138#ifdef _HPUX_SOURCE
139#define SHADOW_P 1
140#define SHADOW_Y 1
141#define SHADOW_S 1
142#define SHADOW_CP 1
143#define SHADOW_HB 1
144#define USE_PREFETCH 1
145#endif
146
147#endif /* __GNUC__ */
148
149#include "Yap.h"
150#include "YapHeap.h"
151#include "clause.h"
152#include "YapEval.h"
153#ifdef HAVE_STRING_H
154#include <string.h>
155#endif
156#if YAP_JIT
157#include "amijit.h"
158#endif
159#ifdef YAPOR
160#include "or.macros.h"
161#endif /* YAPOR */
162#ifdef USE_SYSTEM_MALLOC
163#include "YapHeap.h"
164#endif
165#ifdef TABLING
166#include "tab.macros.h"
167#endif /* TABLING */
168#ifdef LOW_LEVEL_TRACER
169#include "tracer.h"
170#endif
171
172#ifdef DEBUG
173/**********************************************************************
174 * *
175 * Debugging Auxiliary variables *
176 * *
177 **********************************************************************/
178#include <stdio.h>
179#endif
180
181#if PUSH_REGS
182
183/***************************************************************
184 * Trick to copy REGS into absmi local environment *
185 ***************************************************************/
186INLINE_ONLY void init_absmi_regs(REGSTORE *absmi_regs);
187
188/* regp is a global variable */
189
190INLINE_ONLY void init_absmi_regs(REGSTORE *absmi_regs) {
191 CACHE_REGS
192 memmove(absmi_regs, &Yap_REGS, sizeof(REGSTORE));
193}
194
195INLINE_ONLY void restore_absmi_regs(REGSTORE *old_regs);
196
197INLINE_ONLY void restore_absmi_regs(REGSTORE *old_regs) {
198 CACHE_REGS
199 memmove(old_regs, Yap_regp, sizeof(REGSTORE));
200#ifdef THREADS
201 pthread_setspecific(Yap_yaamregs_key, (void *)old_regs);
202 LOCAL_ThreadHandle.current_yaam_regs = old_regs;
203#else
204 Yap_regp = old_regs;
205#endif
206}
207#endif /* PUSH_REGS */
208
209/*****************************************************************
210
211 Machine Dependent stuff
212
213******************************************************************/
214
215#ifdef LONG_LIVED_REGISTERS
216
217#define BEGP(TMP)
218
219#define ENDP(TMP)
220
221#define BEGD(TMP)
222
223#define ENDD(TMP)
224
225#else
226
227#define BEGP(TMP) \
228 { \
229 CELL *TMP
230
231#define ENDP(TMP) }
232
233#define BEGD(TMP) \
234 { \
235 CELL TMP
236
237#define ENDD(TMP) }
238
239#endif /* LONG_LIVED_REGISTERS */
240
241#define BEGCHO(TMP) \
242 { \
243 register choiceptr TMP
244
245#define ENDCHO(TMP) }
246
247/***************************************************************
248 * YREG is usually, but not always, a register. This affects *
249 * choicepoints *
250 ***************************************************************/
251
252#if Y_IN_MEM
253
254#define CACHE_Y(A) \
255 { \
256 register CELL *S_YREG = ((CELL *)(A))
257
258#define ENDCACHE_Y() \
259 YREG = S_YREG; \
260 }
261
262#define B_YREG ((choiceptr)(S_YREG))
263
264#else
265
266#define S_YREG (YREG)
267
268#define B_YREG ((choiceptr)(YREG))
269
270#define CACHE_Y(A) \
271 { \
272 YREG = ((CELL *)(A))
273
274#define ENDCACHE_Y() }
275
276#endif
277
278#if Y_IN_MEM
279
280#define CACHE_Y_AS_ENV(A) \
281 { \
282 register CELL *ENV_YREG = (A)
283
284#define FETCH_Y_FROM_ENV(A) ENV_YREG = (A)
285
286#define WRITEBACK_Y_AS_ENV() YREG = ENV_YREG
287
288#define ENDCACHE_Y_AS_ENV() }
289
290#define saveregs_and_ycache() \
291 YREG = ENV_YREG; \
292 saveregs()
293
294 #define setregs_and_ycache() \
295 ENV_YREG = YREG; \
296 setregs()
297
298#else
299
300#define ENV_YREG (YREG)
301
302#define WRITEBACK_Y_AS_ENV()
303
304#define CACHE_Y_AS_ENV(A) \
305 { \
306 YREG = (A)
307
308#define FETCH_Y_FROM_ENV(A) ((YENV) = (A))
309
310#define ENDCACHE_Y_AS_ENV() }
311
312#define saveregs_and_ycache() saveregs()
313
314#define setregs_and_ycache() setregs()
315
316#endif
317
318/***************************************************************
319 * TR is usually, but not always, a register. This affects *
320 * backtracking *
321 ***************************************************************/
322
323#ifdef _NATIVE
324
325#define CACHE_TR(A) register tr_fr_ptr S_TR = (A)
326
327#define RESTORE_TR() TR = S_TR
328
329#define ENDCACHE_TR()
330
331#else
332
333#define CACHE_TR(A) \
334 { \
335 register tr_fr_ptr S_TR = (A)
336
337#define RESTORE_TR() TR = S_TR
338
339#define ENDCACHE_TR() }
340
341#endif
342
343/***************************************************************
344 * S is usually, but not always, a register (X86 machines). *
345 * This affects unification instructions *
346 ***************************************************************/
347
348#if !SHADOW_S
349#define SREG S
350#endif
351
352#if S_IN_MEM
353
354/* jump through hoops because idiotic gcc will go and read S from
355 memory every time it uses S :-( */
356
357#define CACHE_S() \
358 { \
359 register CELL *S_SREG;
360
361#define ENDCACHE_S() }
362
363#ifndef _NATIVE
364
365#define READ_IN_S() S_SREG = SREG
366
367#define CACHE_A1() {SREG = (CELL *)ARG1; }
368
369#define CACHED_A1() ((CELL)SREG)
370
371#else
372
373#define READ_IN_S() S_SREG = *_SREG
374
375#define CACHE_A1() {(*_SREG) = (CELL *)ARG1; }
376
377#define CACHED_A1() ((CELL)(*_SREG))
378
379 #endif
380
381#else
382
383/* do nothing if you are on a decent machine */
384
385#define CACHE_S() {
386
387#define ENDCACHE_S() }
388
389#define READ_IN_S()
390
391#define CACHE_A1()
392
393#define CACHED_A1() (ARG1)
394
395#define S_SREG SREG
396
397#endif
398
399#ifndef _NATIVE
400
401#define WRITEBACK_S(X) SREG = (X)
402
403#else
404
405#define WRITEBACK_S(X) *_SREG = (X)
406
407#endif
408
409/*****************************************************************
410
411 End of Machine Dependent stuff
412
413******************************************************************/
414
415/*****************************************************************
416
417 Prefetch is a technique to obtain the place to jump to before actually
418 executing instructions. It can speed up some machines, by having the
419 next opcode in place before it is actually required for jumping.
420
421******************************************************************/
422
423#if __YAP_TRACED
424
425#define DO_PREFETCH(TYPE)
426
427#define DO_PREFETCH_W(TYPE)
428
429#elif USE_THREADED_CODE
430
431#ifndef _NATIVE
432
433#if YAP_JIT
434
435#define DO_PREFETCH(TYPE) \
436 if (ExpEnv.config_struc.current_displacement) \
437 to_go = (void *)OpAddress[Yap_op_from_opcode(NEXTOP(PREG, TYPE)->opc) + \
438 ExpEnv.config_struc.current_displacement]; \
439 else \
440 to_go = (void *)(NEXTOP(PREG, TYPE)->opc);
441
442#define DO_PREFETCH_W(TYPE) \
443 if (ExpEnv.config_struc.current_displacement) \
444 to_go = \
445 (void *)OpAddress[Yap_op_from_opcode(NEXTOP(PREG, TYPE)->y_u.o.opcw) + \
446 ExpEnv.config_struc.current_displacement]; \
447 else \
448 to_go = (void *)(NEXTOP(PREG, TYPE)->y_u.o.opcw);
449
450#else /* YAP_JIT */
451
452#define DO_PREFETCH(TYPE) to_go = (void *)(NEXTOP(PREG, TYPE)->opc)
453
454#define DO_PREFETCH_W(TYPE) to_go = (void *)(NEXTOP(PREG, TYPE)->y_u.o.opcw)
455
456#endif /* YAP_JIT */
457
458#else /* _NATIVE */
459
460#define DO_PREFETCH(TYPE)
461
462#define DO_PREFETCH_W(TYPE)
463
464#endif /* _NATIVE */
465
466#ifndef _NATIVE
467
468#if LIMITED_PREFETCH || USE_PREFETCH
469
470#define ALWAYS_START_PREFETCH(TYPE) \
471 { \
472 register void *to_go; \
473 DO_PREFETCH(TYPE)
474
475#if YAP_JIT
476#define ALWAYS_LOOKAHEAD(WHAT) \
477 { \
478 register void *to_go; \
479 if (ExpEnv.config_struc.current_displacement) \
480 to_go = (void *)OpAddress[Yap_op_from_opcode(WHAT) + \
481 ExpEnv.config_struc.current_displacement]; \
482 else \
483 to_go = (void *)(WHAT);
484#else /* YAP_JIT */
485#define ALWAYS_LOOKAHEAD(WHAT) \
486 { \
487 register void *to_go = (void *)(WHAT);
488#endif /* YAP_JIT */
489
490#define ALWAYS_START_PREFETCH_W(TYPE) \
491 { \
492 register void *to_go; \
493 DO_PREFETCH_W(TYPE)
494
495#else
496
497#define ALWAYS_START_PREFETCH(TYPE) {
498
499#define ALWAYS_START_PREFETCH_W(TYPE) {
500
501#define ALWAYS_LOOKAHEAD(WHERE) {
502
503#endif /* LIMITED_PREFETCH||USE_PREFETCH */
504
505#else /* _NATIVE */
506
507#if LIMITED_PREFETCH || USE_PREFETCH
508
509#define ALWAYS_START_PREFETCH(TYPE)
510
511#define ALWAYS_LOOKAHEAD(WHAT)
512
513#define ALWAYS_START_PREFETCH_W(TYPE)
514
515#else
516
517#define ALWAYS_START_PREFETCH(TYPE)
518
519#define ALWAYS_START_PREFETCH_W(TYPE)
520
521#define ALWAYS_LOOKAHEAD(WHERE)
522
523#endif /* LIMITED_PREFETCH||USE_PREFETCH */
524
525#endif /* _NATIVE */
526
527#ifndef _NATIVE
528
529#ifdef USE_PREFETCH
530
531#define START_PREFETCH(TYPE) ALWAYS_START_PREFETCH(TYPE)
532
533#define START_PREFETCH_W(TYPE) ALWAYS_START_PREFETCH_W(TYPE)
534
535#define INIT_PREFETCH() \
536 { \
537 register void *to_go;
538
539#define PREFETCH_OP(X) \
540 if (ExpEnv.config_struc.current_displacement) \
541 to_go = (void *)OpAddress[Yap_op_from_opcode((X)->opc) + \
542 ExpEnv.config_struc.current_displacement]; \
543 else \
544 to_go = (void *)((X)->opc);
545
546#else
547
548#define START_PREFETCH(TYPE) {
549
550#define START_PREFETCH_W(TYPE) {
551
552#define INIT_PREFETCH() {
553
554#define PREFETCH_OP(X)
555
556#endif /* USE_PREFETCH */
557
558#else /* _NATIVE */
559
560#ifdef USE_PREFETCH
561
562#define START_PREFETCH(TYPE) ALWAYS_START_PREFETCH(TYPE)
563
564#define START_PREFETCH_W(TYPE) ALWAYS_START_PREFETCH_W(TYPE)
565
566#define INIT_PREFETCH()
567
568#define PREFETCH_OP(X)
569
570#else
571
572#define START_PREFETCH(TYPE)
573
574#define START_PREFETCH_W(TYPE)
575
576#define INIT_PREFETCH()
577
578#define PREFETCH_OP(X)
579
580#endif /* USE_PREFETCH */
581
582#endif /* _NATIVE */
583
584#else /* USE_THREADED_CODE */
585
586#ifndef _NATIVE
587
588#define ALWAYS_START_PREFETCH(TYPE) {
589
590#define ALWAYS_START_PREFETCH_W(TYPE) {
591
592#define ALWAYS_LOOKAHEAD(WHERE) {
593
594#define START_PREFETCH(TYPE) {
595
596#define START_PREFETCH_W(TYPE) {
597
598#define INIT_PREFETCH() {
599
600#define PREFETCH_OP(X)
601
602#else
603
604#define ALWAYS_START_PREFETCH(TYPE)
605
606#define ALWAYS_START_PREFETCH_W(TYPE)
607
608#define ALWAYS_LOOKAHEAD(WHERE)
609
610#define START_PREFETCH(TYPE)
611
612#define START_PREFETCH_W(TYPE)
613
614#define INIT_PREFETCH()
615
616#define PREFETCH_OP(X)
617
618#endif /* _NATIVE */
619
620#endif /* USE_THREADED_CODE */
621
622#ifndef _NATIVE
623
624#define ALWAYS_END_PREFETCH() }
625
626#define ALWAYS_END_PREFETCH_W() }
627
628#define END_PREFETCH() }
629
630#define END_PREFETCH_W() }
631
632#else
633
634#define ALWAYS_END_PREFETCH()
635
636#define ALWAYS_END_PREFETCH_W()
637
638#define END_PREFETCH()
639
640#define END_PREFETCH_W()
641
642#endif /* _NATIVE */
643
644/*****************************************************************
645
646 How to jump to the next abstract machine instruction
647
648******************************************************************/
649
650#if __YAP_TRACED
651
652#define JMP(Lab) \
653 { \
654 opcode = Yap_op_from_opcode(goto * Lab); \
655 goto op_switch; \
656 }
657
658#define JMPNext(Lab) \
659 { \
660 opcode = Yap_op_from_opcode(PREG->opc) + \
661 ExpEnv.config_struc.current_displacement; \
662 goto op_switch; \
663 }
664
665#define JMPNextW(Lab) \
666 { \
667 opcode = Yap_op_from_opcode(PREG->opcw) + \
668 ExpEnv.config_struc.current_displacement; \
669 goto op_switch; \
670 }
671
672#elif USE_THREADED_CODE
673
674#ifndef _NATIVE
675
676#define JMP(Lab) goto *Lab
677
678#if YAP_JIT
679
680#define JMPNext() \
681 if (ExpEnv.config_struc.current_displacement) \
682 JMP((void *)OpAddress[Yap_op_from_opcode(PREG->opc) + \
683 ExpEnv.config_struc.current_displacement]); \
684 JMP((void *)(PREG->opc))
685
686#define JMPNextW() \
687 if (ExpEnv.config_struc.current_displacement) \
688 JMP((void *)OpAddress[Yap_op_from_opcode(PREG->y_u.o.opcw) + \
689 ExpEnv.config_struc.current_displacement]); \
690 JMP((void *)(PREG->y_u.o.opcw))
691
692#else /* YAP_JIT */
693
694#define JMPNext() JMP((void *)(PREG->opc));
695
696#define JMPNextW() JMP((void *)(PREG->y_u.o.opcw));
697
698#endif /* YAP_JIT */
699
700#else /* _NATIVE */
701
702#if YAP_STAT_PREDS
703
704#if YAP_DBG_PREDS
705
706#define SUCCESSBACK() \
707 { \
708 if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
709 if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && \
710 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && \
711 NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
712 void *(*callee)(yamop **, yamop **, CELL **, void *[], void *[]); \
713 void *go; \
714 callee = (void *(*)(yamop **, yamop **, CELL **, void *[], void *[])) \
715 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
716 go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, \
717 OpAddress); \
718 return go; \
719 } \
720 } \
721 if ((char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != 0 && \
722 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != \
723 (char *)0x1) { \
724 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
725 fprintf(stderr, "%s", \
726 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success); \
727 } \
728 HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
729 NativeArea->success[HEADPREG->y_u.jhc.jh->caa.naddress] += 1; \
730 (ExpEnv.config_struc.torecompile) \
731 ? (ExpEnv.config_struc.current_displacement = \
732 ExpEnv.config_struc.TOTAL_OF_OPCODES) \
733 : (ExpEnv.config_struc.current_displacement = 0); \
734 if (ExpEnv.config_struc.current_displacement) \
735 return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc) + \
736 ExpEnv.config_struc.current_displacement]); \
737 return ((void *)((*_PREG)->opc)); \
738 }
739
740#define BACK() \
741 { \
742 if ((char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != 0 && \
743 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != \
744 (char *)0x1) { \
745 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
746 fprintf(stderr, "%s", \
747 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail); \
748 } \
749 return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); \
750 }
751
752#else /* YAP_DBG_PREDS */
753
754#define SUCCESSBACK() \
755 { \
756 if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
757 if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && \
758 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && \
759 NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
760 void *(*callee)(yamop **, yamop **, CELL **, void *[], void *[]); \
761 void *go; \
762 callee = (void *(*)(yamop **, yamop **, CELL **, void *[], void *[])) \
763 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
764 go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, \
765 OpAddress); \
766 return go; \
767 } \
768 } \
769 HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
770 NativeArea->success[HEADPREG->y_u.jhc.jh->caa.naddress] += 1; \
771 (ExpEnv.config_struc.torecompile) \
772 ? (ExpEnv.config_struc.current_displacement = \
773 ExpEnv.config_struc.TOTAL_OF_OPCODES) \
774 : (ExpEnv.config_struc.current_displacement = 0); \
775 if (ExpEnv.config_struc.current_displacement) \
776 return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc) + \
777 ExpEnv.config_struc.current_displacement]); \
778 return ((void *)((*_PREG)->opc)); \
779 }
780
781#define BACK() \
782 { return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); }
783
784#endif /* YAP_DBG_PREDS */
785
786#else /* YAP_STAT_PREDS */
787
788#if YAP_DBG_PREDS
789
790#define SUCCESSBACK() \
791 { \
792 if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
793 if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && \
794 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && \
795 NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
796 void *(*callee)(yamop **, yamop **, CELL **, void *[], void *[]); \
797 void *go; \
798 callee = (void *(*)(yamop **, yamop **, CELL **, void *[], void *[])) \
799 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
800 go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, \
801 OpAddress); \
802 return go; \
803 } \
804 } \
805 if ((char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != 0 && \
806 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != \
807 (char *)0x1) { \
808 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
809 fprintf(stderr, "%s", \
810 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success); \
811 } \
812 HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
813 (ExpEnv.config_struc.torecompile) \
814 ? (ExpEnv.config_struc.current_displacement = \
815 ExpEnv.config_struc.TOTAL_OF_OPCODES) \
816 : (ExpEnv.config_struc.current_displacement = 0); \
817 if (ExpEnv.config_struc.current_displacement) \
818 return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc) + \
819 ExpEnv.config_struc.current_displacement]); \
820 return ((void *)((*_PREG)->opc)); \
821 }
822
823#define BACK() \
824 { \
825 if ((char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != 0 && \
826 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != \
827 (char *)0x1) { \
828 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
829 fprintf(stderr, "%s", \
830 (char *)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail); \
831 } \
832 return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); \
833 }
834
835#else /* YAP_DBG_PREDS */
836
837#define SUCCESSBACK() \
838 { \
839 if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
840 if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && \
841 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && \
842 NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
843 void *(*callee)(yamop **, yamop **, CELL **, void *[], void *[]); \
844 void *go; \
845 callee = (void *(*)(yamop **, yamop **, CELL **, void *[], void *[])) \
846 NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
847 go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, \
848 OpAddress); \
849 return go; \
850 } \
851 } \
852 HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
853 (ExpEnv.config_struc.torecompile) \
854 ? (ExpEnv.config_struc.current_displacement = \
855 ExpEnv.config_struc.TOTAL_OF_OPCODES) \
856 : (ExpEnv.config_struc.current_displacement = 0); \
857 if (ExpEnv.config_struc.current_displacement) \
858 return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc) + \
859 ExpEnv.config_struc.current_displacement]); \
860 return ((void *)((*_PREG)->opc)); \
861 }
862
863#define BACK() \
864 { return ((void *)OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); }
865
866#endif /* YAP_DBG_PREDS */
867
868#endif /* YAP_STAT_PREDS */
869
870#define JMP(Lab)
871
872#define JMPNext()
873
874#define JMPNextW()
875
876#endif /* _NATIVE */
877
878#if USE_THREADED_CODE && (LIMITED_PREFETCH || USE_PREFETCH)
879
880#define ALWAYS_GONext() JMP(to_go)
881
882#define ALWAYS_GONextW() JMP(to_go)
883
884#else
885
886#define ALWAYS_GONext() JMPNext()
887
888#define ALWAYS_GONextW() JMPNextW()
889
890#endif
891
892#ifdef USE_PREFETCH
893
894#define GONext() ALWAYS_GONext()
895
896#define GONextW() ALWAYS_GONextW()
897
898#else
899
900#define GONext() JMPNext()
901
902#define GONextW() JMPNextW()
903
904#endif /* USE_PREFETCH */
905
906#if YAP_DBG_PREDS
907
908#if YAP_JIT
909
910#define Op(Label, Type) \
911 _##Label : { \
912 (ExpEnv.config_struc.current_displacement) \
913 ? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
914 : print_instruction(PREG, ON_INTERPRETER); \
915 START_PREFETCH(Type)
916
917#define OpW(Label, Type) \
918 _##Label : { \
919 (ExpEnv.config_struc.current_displacement) \
920 ? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
921 : print_instruction(PREG, ON_INTERPRETER); \
922 START_PREFETCH_W(Type)
923
924#define BOp(Label, Type) \
925 _##Label : { \
926 (ExpEnv.config_struc.current_displacement) \
927 ? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
928 : print_instruction(PREG, ON_INTERPRETER);
929
930#define PBOp(Label, Type) \
931 _##Label : { \
932 (ExpEnv.config_struc.current_displacement) \
933 ? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
934 : print_instruction(PREG, ON_INTERPRETER); \
935 INIT_PREFETCH()
936
937#define OpRW(Label, Type) \
938 _##Label : { \
939 (ExpEnv.config_struc.current_displacement) \
940 ? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
941 : print_instruction(PREG, ON_INTERPRETER);
942
943#else /* YAP_JIT */
944
945#define Op(Label, Type) \
946 _##Label : { \
947 print_instruction(PREG, ON_INTERPRETER); \
948 START_PREFETCH(Type)
949
950#define OpW(Label, Type) \
951 _##Label : { \
952 print_instruction(PREG, ON_INTERPRETER); \
953 START_PREFETCH_W(Type)
954
955#define BOp(Label, Type) \
956 _##Label : { \
957 print_instruction(PREG, ON_INTERPRETER);
958
959#define PBOp(Label, Type) \
960 _##Label : { \
961 print_instruction(PREG, ON_INTERPRETER); \
962 INIT_PREFETCH()
963
964#define OpRW(Label, Type) \
965 _##Label : { \
966 print_instruction(PREG, ON_INTERPRETER);
967
968#endif /* YAP_JIT */
969
970#else /* YAP_DBG_PREDS */
971
972#define Op(Label, Type) \
973 _##Label : { \
974 START_PREFETCH(Type)
975
976#define OpW(Label, Type) \
977 _##Label : { \
978 START_PREFETCH_W(Type)
979
980#define BOp(Label, Type) \
981 _##Label : {
982
983#define PBOp(Label, Type) \
984 _##Label : { \
985 INIT_PREFETCH()
986
987#define OpRW(Label, Type) _##Label : {
988
989#endif /* YAP_DBG_PREDS */
990
991#else /* do not use threaded code */
992
993#define JMPNext() goto nextop
994
995#define JMPNextW() goto nextop_write
996
997#define GONext() JMPNext()
998
999#define GONextW() JMPNextW()
1000
1001#define ALWAYS_GONext() GONext()
1002
1003#define ALWAYS_GONextW() GONextW()
1004
1005#define Op(Label, Type) \
1006 case _##Label: { \
1007 START_PREFETCH(Type)
1008
1009#define OpW(Label, Type) \
1010 case _##Label: { \
1011 START_PREFETCH_W(Type)
1012
1013#define BOp(Label, Type) case _##Label: {
1014
1015#define PBOp(Label, Type) \
1016 case _##Label: { \
1017 INIT_PREFETCH()
1018
1019#define OpRW(Label, Type) case _##Label: {
1020
1021#endif
1022
1023#define ENDOp() \
1024 END_PREFETCH() \
1025 }
1026
1027#define ENDOpW() \
1028 END_PREFETCH_W() \
1029 }
1030
1031#define ENDOpRW() }
1032
1033#define ENDBOp() }
1034
1035#define ENDPBOp() \
1036 END_PREFETCH() \
1037 }
1038
1039/**********************************************************************
1040 * *
1041 * PC manipulation *
1042 * *
1043 **********************************************************************/
1044
1045/*
1046 * How to set up and move a PC in a nice and disciplined way
1047 *
1048 */
1049
1050typedef CELL label;
1051
1052/* move PC */
1053
1054#define ADJ(P, x) (P) + ADJUST(sizeof(x))
1055
1056/*
1057 * Lookup PredEntry Structure
1058 *
1059 */
1060
1061#define pred_entry(X) \
1062 ((PredEntry *)(Unsigned(X) - (CELL)(&(((PredEntry *)NULL)->StateOfPred))))
1063#define pred_entry_from_code(X) \
1064 ((PredEntry *)(Unsigned(X) - (CELL)(&(((PredEntry *)NULL)->CodeOfPred))))
1065#define PredFromDefCode(X) \
1066 ((PredEntry *)(Unsigned(X) - (CELL)(&(((PredEntry *)NULL)->OpcodeOfPred))))
1067#define PredFromExpandCode(X) \
1068 ((PredEntry *)(Unsigned(X) - \
1069 (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))))
1070#define PredCode(X) pred_entry(X)->CodeOfPred
1071#define PredOpCode(X) pred_entry(X)->OpcodeOfPred
1072#define TruePredCode(X) pred_entry(X)->TrueCodeOfPred
1073#define PredFunctor(X) pred_entry(X)->FunctorOfPred
1074#define PredArity(X) pred_entry(X)->ArityOfPE
1075
1076#define FlagOff(Mask, w) !(Mask & w)
1077#define FlagOn(Mask, w) (Mask & w)
1078#define ResetFlag(Mask, w) w &= ~Mask
1079#define SetFlag(Mask, w) w |= Mask
1080
1081/**********************************************************************
1082 * *
1083 * X register access *
1084 * *
1085 **********************************************************************/
1086
1087#if PRECOMPUTE_REGADDRESS
1088
1089#define XREG(I) (*(CELL *)(I))
1090
1091#else
1092
1093#define XREG(I) XREGS[I]
1094
1095#endif /* PRECOMPUTE_REGADDRESS */
1096
1097/* The Unification Stack is the Auxiliary stack */
1098
1099#define SP0 ((CELL *)AuxTop)
1100#define SP AuxSp
1101
1102/**********************************************************************
1103 * *
1104 * RWREG Manipulatio *
1105 * *
1106 **********************************************************************/
1107
1108#define READ_MODE 1
1109#define WRITE_MODE 0
1110
1111/**********************************************************************
1112 * *
1113 *Setting Temporary Copies of Often Used WAM registers for efficiency *
1114 * *
1115 **********************************************************************/
1116
1117#ifdef SHADOW_P
1118#define NEEDS_TO_SET_PC 1
1119#endif
1120
1121/*
1122 * First, the PC
1123 */
1124#ifdef NEEDS_TO_SET_PC
1125#ifndef _NATIVE
1126#define set_pc() PREG = P
1127#define save_pc() P = PREG
1128#else
1129#define set_pc() (*_PREG) = P
1130#define save_pc() P = (*_PREG)
1131#endif
1132#else
1133#define set_pc()
1134#define save_pc()
1135#define PREG (P)
1136#endif
1137
1138/*
1139 * Next, Y
1140 */
1141#ifdef SHADOW_Y
1142#define set_y() YREG = YENV
1143#define save_y() YENV = YREG
1144#else
1145#define set_y()
1146#define save_y()
1147#define YREG YENV
1148#endif
1149
1150/*
1151 * Next, CP
1152 */
1153#ifdef SHADOW_CP
1154#ifndef _NATIVE
1155#define set_cp() CPREG = CP
1156#define save_cp() CP = CPREG
1157#else
1158#define set_cp() (*_CPREG) = CP
1159#define save_cp() CP = (*_CPREG)
1160#endif
1161#else
1162#define set_cp()
1163#define save_cp()
1164#define CPREG CP
1165#endif
1166
1167/* Say which registers must be saved at register entry and register
1168 * exit */
1169#define setregs() { \
1170 set_hb(); \
1171 set_cp(); \
1172 set_pc(); \
1173 set_y(); }
1174
1175#define saveregs() { \
1176 save_hb(); \
1177 save_cp(); \
1178 save_pc(); \
1179 save_y() }
1180
1181#if BP_FREE
1182/* if we are using BP as a local register, we must save it whenever we leave
1183 * absmi.c */
1184#define always_save_pc() save_pc()
1185#define always_set_pc() set_pc()
1186#else
1187#define always_save_pc()
1188#define always_set_pc()
1189#endif /* BP_FREE */
1190
1191/************************************************************
1192
1193Macros to check the limits of stacks
1194
1195*************************************************************/
1196
1197#if HAVE_SIGSEGV
1198/* for the moment I don't know how to handle trail overflows
1199 in a pure Windows environment
1200*/
1201#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(THREADS) && \
1202 !defined(YAPOR) && !defined(USE_SYSTEM_MALLOC) && !USE_DL_MALLOC
1203#define OS_HANDLES_TR_OVERFLOW 1
1204#endif
1205#endif
1206
1207#ifdef OS_HANDLES_TR_OVERFLOW
1208
1209#define check_trail(x)
1210
1211#define check_trail_in_indexing(x)
1212
1213#else
1214
1215#ifdef _NATIVE
1216
1217#if YAP_DBG_PREDS
1218
1219#define check_trail(x) \
1220 if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)), 0)) { \
1221 if ((char *)ExpEnv.debug_struc.pprint_me.native_treat_trail != 0 && \
1222 (char *)ExpEnv.debug_struc.pprint_me.native_treat_trail != \
1223 (char *)0x1) { \
1224 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
1225 fprintf(stderr, "%s", \
1226 (char *)ExpEnv.debug_struc.pprint_me.native_treat_trail); \
1227 } \
1228 return external_labels[9]; \
1229 }
1230
1231#else /* YAP_DBG_PREDS */
1232
1233#define check_trail(x) \
1234 if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)), 0)) { \
1235 return external_labels[9]; \
1236 }
1237
1238#endif /* YAP_DBG_PREDS */
1239
1240#define check_trail_in_indexing(x) \
1241 if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)), 0)) \
1242 goto notrailleft_from_index
1243
1244#else
1245
1246#if YAP_DBG_PREDS
1247
1248#define check_trail(x) \
1249 if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)), 0)) { \
1250 if ((char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_trail != 0 && \
1251 (char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_trail != \
1252 (char *)0x1) { \
1253 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
1254 fprintf(stderr, "%s", \
1255 (char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_trail); \
1256 } \
1257 goto notrailleft; \
1258 }
1259
1260#else /* YAP_DBG_PREDS */
1261
1262#define check_trail(x) \
1263 if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)), 0)) { \
1264 goto notrailleft; \
1265 }
1266
1267#endif /* YAP_DBG_PREDS */
1268
1269#define check_trail_in_indexing(x) \
1270 if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)), 0)) \
1271 goto notrailleft_from_index
1272
1273#endif /* _NATIVE */
1274
1275#endif /* OS_HANDLES_TR_OVERFLOW */
1276
1277#if YAP_DBG_PREDS
1278#if (defined(YAPOR_SBA) && defined(YAPOR)) || defined(TABLING)
1279#define check_stack(Label, GLOB) \
1280 if (__builtin_expect( \
1281 ((Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG, B_FZ)) - \
1282 Unsigned(YOUNGEST_H(H_FZ, GLOB))) < CreepFlag), \
1283 0)) { \
1284 if ((char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != 0 && \
1285 (char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != \
1286 (char *)0x1) { \
1287 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
1288 fprintf(stderr, "%s", \
1289 (char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap); \
1290 } \
1291 goto Label; \
1292 }
1293#else
1294#define check_stack(Label, GLOB) \
1295 if (__builtin_expect( \
1296 ((Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CreepFlag), 0)) { \
1297 if ((char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != 0 && \
1298 (char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != \
1299 (char *)0x1) { \
1300 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
1301 fprintf(stderr, "%s", \
1302 (char *)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap); \
1303 } \
1304 goto Label; \
1305 }
1306#endif /* YAPOR_SBA && YAPOR */
1307#else /* YAP_DBG_PREDS */
1308#if (defined(YAPOR_SBA) && defined(YAPOR)) || defined(TABLING)
1309#define check_stack(Label, GLOB) \
1310 if (__builtin_expect( \
1311 ((Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG, B_FZ)) - \
1312 Unsigned(YOUNGEST_H(H_FZ, GLOB))) < CreepFlag), \
1313 0)) { \
1314 goto Label; \
1315 }
1316#else
1317#define check_stack(Label, GLOB) \
1318 if (__builtin_expect( \
1319 ((Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CreepFlag), 0)) { \
1320 goto Label; \
1321 }
1322#endif /* YAPOR_SBA && YAPOR */
1323#endif /* YAP_DBG_PREDS */
1324
1325/***************************************************************
1326 * Macros for choice point manipulation *
1327 ***************************************************************/
1328
1329/***************************************************************
1330 * Store variable number of arguments in a choice point *
1331 ***************************************************************/
1332/***
1333 pt1 points at the new choice point,
1334 pt0 points at XREGS[i]
1335 d0 is a counter
1336 The macro just pushes the arguments one by one to the local stack.
1337***/
1338#define store_args(arity) \
1339 BEGP(pt0); \
1340 pt0 = XREGS + (arity); \
1341 while (pt0 > XREGS) { \
1342 register CELL x = pt0[0]; \
1343 S_YREG = S_YREG - 1; \
1344 --pt0; \
1345 (S_YREG)[0] = x; \
1346 } \
1347 ENDP(pt0)
1348
1349#define store_at_least_one_arg(arity) \
1350 BEGP(pt0); \
1351 pt0 = XREGS + (arity); \
1352 do { \
1353 CELL x = pt0[0]; \
1354 S_YREG = (S_YREG)-1; \
1355 --pt0; \
1356 (S_YREG)[0] = x; \
1357 } while (pt0 > XREGS); \
1358 ENDP(pt0)
1359
1360#if LOW_LEVEL_TRACER && 0
1361#define COUNT_CPS() LOCAL_total_choicepoints++
1362#else
1363#define COUNT_CPS()
1364#endif
1365
1366/***************************************************************
1367 * Do the bulk of work in creating a choice-point *
1368 * AP: alternative pointer *
1369 ***************************************************************/
1370/*
1371 * The macro just sets pt1 to point to the base of the choicepoint
1372 * and then fills in all the necessary fields
1373 */
1374#ifdef DEPTH_LIMIT
1375#define store_yaam_reg_cpdepth(CPTR) (CPTR)->cp_depth = DEPTH
1376#else
1377#define store_yaam_reg_cpdepth(CPTR)
1378#endif
1379
1380#ifndef _NATIVE
1381#define store_yaam_regs(AP, I) \
1382 { /* Jump to CP_BASE */ \
1383 COUNT_CPS(); \
1384 S_YREG = (CELL *)((choiceptr)((S_YREG) - (I)) - 1); \
1385 /* Save Information */ \
1386 HBREG = HR; \
1387 B_YREG->cp_tr = TR; \
1388 B_YREG->cp_h = HR; \
1389 B_YREG->cp_b = B; \
1390 store_yaam_reg_cpdepth(B_YREG); \
1391 B_YREG->cp_cp = CPREG; \
1392 B_YREG->cp_ap = AP; \
1393 B_YREG->cp_env = ENV; \
1394 }
1395#else /* _NATIVE */
1396#define store_yaam_regs(AP, I) \
1397 { /* Jump to CP_BASE */ \
1398 COUNT_CPS(); \
1399 S_YREG = (CELL *)((choiceptr)((S_YREG) - (I)) - 1); \
1400 /* Save Information */ \
1401 HBREG = HR; \
1402 B_YREG->cp_tr = TR; \
1403 B_YREG->cp_h = HR; \
1404 B_YREG->cp_b = B; \
1405 store_yaam_reg_cpdepth(B_YREG); \
1406 B_YREG->cp_cp = (*_CPREG); \
1407 B_YREG->cp_ap = AP; \
1408 B_YREG->cp_env = ENV; \
1409 }
1410#endif
1411
1412#define store_yaam_regs_for_either(AP, d0) \
1413 COUNT_CPS(); \
1414 pt1--; /* Jump to CP_BASE */ \
1415 /* Save Information */ \
1416 HBREG = HR; \
1417 pt1->cp_tr = TR; \
1418 pt1->cp_h = HR; \
1419 pt1->cp_b = B; \
1420 store_yaam_reg_cpdepth(pt1); \
1421 pt1->cp_cp = d0; \
1422 pt1->cp_ap = AP; \
1423 pt1->cp_env = ENV;
1424
1425/***************************************************************
1426 * Place B as the new place to cut to *
1427 ***************************************************************/
1428#define set_cut(E, B) (E)[E_CB] = (CELL)(B)
1429
1430/***************************************************************
1431 * Restore WAM registers from a choice point *
1432 ***************************************************************/
1433
1434#ifdef DEPTH_LIMIT
1435#define restore_yaam_reg_cpdepth(CPTR) DEPTH = (CPTR)->cp_depth
1436#else
1437#define restore_yaam_reg_cpdepth(CPTR)
1438#endif
1439
1440#ifdef YAPOR
1441#define YAPOR_update_alternative(CUR_ALT, NEW_ALT) \
1442 if (SCH_top_shared_cp(B)) { \
1443 SCH_new_alternative(CUR_ALT, NEW_ALT); \
1444 } else
1445#else
1446#define YAPOR_update_alternative(CUR_ALT, NEW_ALT)
1447#endif /* YAPOR */
1448
1449#if defined(FROZEN_STACKS) && !defined(BFZ_TRAIL_SCHEME)
1450#define SET_BB(V) BBREG = (V)
1451#else
1452#define SET_BB(V)
1453#endif /* FROZEN_STACKS && !BFZ_TRAIL_SCHEME */
1454
1455#ifdef FROZEN_STACKS
1456#ifdef YAPOR_SBA
1457#define PROTECT_FROZEN_H(CPTR) \
1458 ((Unsigned((Int)((CPTR)->cp_h) - (Int)(H_FZ)) < \
1459 Unsigned((Int)(B_FZ) - (Int)(H_FZ))) \
1460 ? (CPTR)->cp_h \
1461 : H_FZ)
1462#define PROTECT_FROZEN_B(CPTR) \
1463 ((Unsigned((Int)(CPTR) - (Int)(H_FZ)) < Unsigned((Int)(B_FZ) - (Int)(H_FZ))) \
1464 ? (CPTR) \
1465 : B_FZ)
1466/*
1467 #define PROTECT_FROZEN_H(CPTR) ((CPTR)->cp_h > H_FZ && (CPTR)->cp_h < (CELL
1468 *)B_FZ ? (CPTR)->cp_h : H_FZ )
1469
1470 #define PROTECT_FROZEN_B(CPTR) ((CPTR) < B_FZ && (CPTR) > (choiceptr)H_FZ ?
1471 (CPTR) : B_FZ )
1472*/
1473#else /* TABLING */
1474#define PROTECT_FROZEN_B(CPTR) (YOUNGER_CP(CPTR, B_FZ) ? CPTR : B_FZ)
1475#define PROTECT_FROZEN_H(CPTR) (((CPTR)->cp_h > H_FZ) ? (CPTR)->cp_h : H_FZ)
1476#endif /* YAPOR_SBA */
1477#else
1478#define PROTECT_FROZEN_B(CPTR) (CPTR)
1479#define PROTECT_FROZEN_H(CPTR) (CPTR)->cp_h
1480#endif /* FROZEN_STACKS */
1481
1482#ifndef _NATIVE
1483#define restore_yaam_regs(AP) \
1484 { \
1485 register CELL *x1 = B_YREG->cp_env; \
1486 register yamop *x2; \
1487 HR = HBREG = PROTECT_FROZEN_H(B_YREG); \
1488 restore_yaam_reg_cpdepth(B_YREG); \
1489 CPREG = B_YREG->cp_cp; \
1490 /* AP may depend on H */ \
1491 x2 = (yamop *)AP; \
1492 ENV = x1; \
1493 YAPOR_update_alternative(PREG, x2) B_YREG->cp_ap = x2; \
1494 }
1495#else
1496#define restore_yaam_regs(AP) \
1497 { \
1498 register CELL *x1 = B_YREG->cp_env; \
1499 register yamop *x2; \
1500 H = HBREG = PROTECT_FROZEN_H(B_YREG); \
1501 restore_yaam_reg_cpdepth(B_YREG); \
1502 (*_CPREG) = B_YREG->cp_cp; \
1503 /* AP may depend on H */ \
1504 x2 = (yamop *)AP; \
1505 ENV = x1; \
1506 YAPOR_update_alternative((*_PREG), x2) B_YREG->cp_ap = x2; \
1507 }
1508#endif
1509
1510/***************************************************************
1511 * Restore variable number of arguments from a choice point *
1512 ***************************************************************/
1513#define restore_args(Nargs) \
1514 BEGD(d0); \
1515 d0 = Nargs; \
1516 BEGP(pt0); \
1517 BEGP(pt1); \
1518 pt1 = (CELL *)(B_YREG + 1) + d0; \
1519 pt0 = XREGS + 1 + d0; \
1520 while (pt0 > XREGS + 1) { \
1521 register CELL x = pt1[-1]; \
1522 --pt0; \
1523 --pt1; \
1524 *pt0 = x; \
1525 } \
1526 ENDP(pt1); \
1527 ENDP(pt0); \
1528 ENDD(d0)
1529
1530#define restore_at_least_one_arg(Nargs) \
1531 BEGD(d0); \
1532 d0 = Nargs; \
1533 BEGP(pt0); \
1534 BEGP(pt1); \
1535 pt1 = (CELL *)(B_YREG + 1) + d0; \
1536 pt0 = XREGS + 1 + d0; \
1537 do { \
1538 register CELL x = pt1[-1]; \
1539 --pt0; \
1540 --pt1; \
1541 *pt0 = x; \
1542 } while (pt0 > XREGS + 1); \
1543 ENDP(pt1); \
1544 ENDP(pt0); \
1545 ENDD(d0)
1546
1547/***************************************************************
1548 * Execute trust to release YAAM registers and pop choice point *
1549 ***************************************************************/
1550#ifdef DEPTH_LIMIT
1551#define pop_yaam_reg_cpdepth(CPTR) DEPTH = (CPTR)->cp_depth
1552#else
1553#define pop_yaam_reg_cpdepth(CPTR)
1554#endif
1555
1556#ifdef TABLING
1557#define TABLING_close_alt(CPTR) (CPTR)->cp_ap = NULL
1558#else
1559#define TABLING_close_alt(CPTR)
1560#endif /* TABLING */
1561
1562#ifndef _NATIVE
1563#define pop_yaam_regs() \
1564 { \
1565 HR = PROTECT_FROZEN_H(B_YREG); \
1566 B = B_YREG->cp_b; \
1567 pop_yaam_reg_cpdepth(B_YREG); \
1568 CPREG = B_YREG->cp_cp; \
1569 ENV = B_YREG->cp_env; \
1570 TABLING_close_alt(B_YREG); \
1571 HBREG = PROTECT_FROZEN_H(B); \
1572 }
1573#else
1574#define pop_yaam_regs() \
1575 { \
1576 HR = PROTECT_FROZEN_H(B_YREG); \
1577 B = B_YREG->cp_b; \
1578 pop_yaam_reg_cpdepth(B_YREG); \
1579 (*_CPREG) = B_YREG->cp_cp; \
1580 ENV = B_YREG->cp_env; \
1581 TABLING_close_alt(B_YREG); \
1582 HBREG = PROTECT_FROZEN_H(B); \
1583 }
1584#endif
1585
1586#define pop_args(NArgs) \
1587 BEGD(d0); \
1588 d0 = (NArgs); \
1589 BEGP(pt0); \
1590 BEGP(pt1); \
1591 S_YREG = (CELL *)(B_YREG + 1); \
1592 pt0 = XREGS + 1; \
1593 pt1 = S_YREG; \
1594 while (pt0 < XREGS + 1 + d0) { \
1595 register CELL x = pt1[0]; \
1596 pt1++; \
1597 pt0++; \
1598 pt0[-1] = x; \
1599 } \
1600 S_YREG = pt1; \
1601 ENDP(pt1); \
1602 ENDP(pt0); \
1603 ENDD(d0);
1604
1605#define pop_at_least_one_arg(NArgs) \
1606 BEGD(d0); \
1607 d0 = (NArgs); \
1608 BEGP(pt0); \
1609 BEGP(pt1); \
1610 pt1 = (CELL *)(B_YREG + 1); \
1611 pt0 = XREGS + 1; \
1612 do { \
1613 register CELL x = pt1[0]; \
1614 pt1++; \
1615 pt0++; \
1616 pt0[-1] = x; \
1617 } while (pt0 < XREGS + 1 + d0); \
1618 S_YREG = pt1; \
1619 ENDP(pt1); \
1620 ENDP(pt0); \
1621 ENDD(d0);
1622
1623/**********************************************************************
1624 * *
1625 * failure and backtracking *
1626 * *
1627 **********************************************************************/
1628
1629/* Failure can be called from two routines.
1630 *
1631 * If from within the emulator, we should jump to the label fail.
1632 *
1633 * If from within the complex-term unification routine, we should jump
1634 * to the label "cufail".
1635 *
1636 */
1637
1638#ifndef _NATIVE
1639
1640#if YAP_DBG_PREDS
1641
1642#define FAIL() \
1643 { \
1644 if ((char *)ExpEnv.debug_struc.pprint_me.interpreted_backtrack != 0 && \
1645 (char *)ExpEnv.debug_struc.pprint_me.interpreted_backtrack != \
1646 (char *)0x1) { \
1647 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
1648 fprintf(stderr, "%s", \
1649 (char *)ExpEnv.debug_struc.pprint_me.interpreted_backtrack); \
1650 } \
1651 goto fail; \
1652 }
1653
1654#define TRACED_FAIL() \
1655 { \
1656 if ((char *)ExpEnv.debug_struc.pprint_me.profiled_interpreted_backtrack != \
1657 0 && \
1658 (char *)ExpEnv.debug_struc.pprint_me.profiled_interpreted_backtrack != \
1659 (char *)0x1) { \
1660 fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
1661 fprintf(stderr, "%s", (char *)ExpEnv.debug_struc.pprint_me \
1662 .profiled_interpreted_backtrack); \
1663 } \
1664 goto traced_fail; \
1665 }
1666
1667#else /* YAP_DBG_PREDS */
1668
1669#define FAIL() \
1670 { goto fail; }
1671
1672#define TRACED_FAIL() \
1673 { goto traced_fail; }
1674
1675#endif /* YAP_DBG_PREDS */
1676
1677#else
1678
1679#define FAIL() \
1680 { return external_labels[0]; }
1681
1682#endif
1683
1684/**********************************************************************
1685 * *
1686 * unification routines *
1687 * *
1688 **********************************************************************/
1689
1690#define UnifyGlobalCells(a, b) \
1691 if ((b) > (a)) { \
1692 if (GlobalIsAttVar(b) && !GlobalIsAttVar(a)) { \
1693 Bind_Global((a), (CELL)(b)); \
1694 } else { \
1695 Bind_Global((b), (CELL)(a)); \
1696 } \
1697 } else if ((b) < (a)) { \
1698 if (GlobalIsAttVar(a) && !GlobalIsAttVar(b)) { \
1699 Bind_Global((b), (CELL)(a)); \
1700 } else { \
1701 Bind_Global((a), (CELL)(b)); \
1702 } \
1703 }
1704
1705#define UnifyGlobalCellToCell(b, a) \
1706 if ((a) < HR) { /* two globals */ \
1707 UnifyGlobalCells(a, b); \
1708 } else { \
1709 Bind_Local((a), (CELL)(b)); \
1710 }
1711
1712#define UnifyCells(a, b) \
1713 if ((a) < HR) { /* at least one global */ \
1714 if ((b) > HR) { \
1715 Bind_Local((b), (CELL)(a)); \
1716 } else { \
1717 UnifyGlobalCells(a, b); \
1718 } \
1719 } else { \
1720 if ((b) > (a)) { \
1721 Bind_Local((a), (CELL)(b)); \
1722 } else if ((a) > (b)) { \
1723 if ((b) < HR) { \
1724 Bind_Local((a), (CELL)(b)); \
1725 } else { \
1726 Bind_Local((b), (CELL)(a)); \
1727 } \
1728 } \
1729 }
1730
1731/* unify two complex terms.
1732 *
1733 * I use two stacks: one keeps the visited terms, and the other keeps the
1734 * terms to visit.
1735 *
1736 * The terms-to-visit stack is used to implement traditional
1737 * recursion. The visited-terms-stack is used to link structures already
1738 * visited and allows unification of infinite terms
1739 *
1740 */
1741
1742#ifdef RATIONAL_TREES
1743
1744#define UNWIND_CUNIF() \
1745 while (visited < AuxSp) { \
1746 pt1 = (CELL *)visited[0]; \
1747 *pt1 = visited[1]; \
1748 visited += 2; \
1749 }
1750
1751#else
1752#define UNWIND_CUNIF()
1753#endif
1754
1755#define UnifyBound_TEST_ATTACHED(f, d0, pt0, d1) \
1756 if (IsExtensionFunctor(f)) { \
1757 if (unify_extension(f, d0, RepAppl(d0), d1)) { \
1758 GONext(); \
1759 } else { \
1760 FAIL(); \
1761 } \
1762 }
1763
1764#define UnifyBound(d0, d1) \
1765 if (d0 == d1) { \
1766 GONext(); \
1767 } \
1768 if (IsPairTerm(d0)) { \
1769 register CELL *ipt0, *ipt1; \
1770 if (!IsPairTerm(d1)) { \
1771 FAIL(); \
1772 } \
1773 ipt0 = RepPair(d0); \
1774 ipt1 = RepPair(d1); \
1775 save_hb(); \
1776 always_save_pc(); \
1777 if (IUnify_complex(ipt0 - 1, ipt0 + 1, ipt1 - 1)) { \
1778 always_set_pc(); \
1779 GONext(); \
1780 } else { \
1781 FAIL(); \
1782 } \
1783 } else if (IsApplTerm(d0)) { \
1784 register CELL *ipt0, *ipt1; \
1785 register Functor f; \
1786 if (!IsApplTerm(d1)) { \
1787 FAIL(); \
1788 } \
1789 ipt0 = RepAppl(d0); \
1790 ipt1 = RepAppl(d1); \
1791 f = (Functor)*ipt0; \
1792 if (f != (Functor)*ipt1) { \
1793 FAIL(); \
1794 } \
1795 UnifyBound_TEST_ATTACHED(f, d0, ipt0, d1); \
1796 d0 = ArityOfFunctor(f); \
1797 always_save_pc(); \
1798 save_hb(); \
1799 if (IUnify_complex(ipt0, ipt0 + d0, ipt1)) { \
1800 always_set_pc(); \
1801 GONext(); \
1802 } else { \
1803 FAIL(); \
1804 } \
1805 } else { \
1806 FAIL(); \
1807 }
1808
1809#define traced_UnifyBound_TEST_ATTACHED(f, d0, pt0, d1) \
1810 if (IsExtensionFunctor(f)) { \
1811 if (unify_extension(f, d0, RepAppl(d0), d1)) { \
1812 GONext(); \
1813 } else { \
1814 TRACED_FAIL(); \
1815 } \
1816 }
1817
1818#define traced_UnifyBound(d0, d1) \
1819 if (d0 == d1) { \
1820 GONext(); \
1821 } \
1822 if (IsPairTerm(d0)) { \
1823 register CELL *ipt0, *ipt1; \
1824 if (!IsPairTerm(d1)) { \
1825 TRACED_FAIL(); \
1826 } \
1827 ipt0 = RepPair(d0); \
1828 ipt1 = RepPair(d1); \
1829 save_hb(); \
1830 always_save_pc(); \
1831 if (IUnify_complex(ipt0 - 1, ipt0 + 1, ipt1 - 1)) { \
1832 always_set_pc(); \
1833 GONext(); \
1834 } else { \
1835 TRACED_FAIL(); \
1836 } \
1837 } else if (IsApplTerm(d0)) { \
1838 register CELL *ipt0, *ipt1; \
1839 register Functor f; \
1840 if (!IsApplTerm(d1)) { \
1841 TRACED_FAIL(); \
1842 } \
1843 ipt0 = RepAppl(d0); \
1844 ipt1 = RepAppl(d1); \
1845 f = (Functor)*ipt0; \
1846 if (f != (Functor)*ipt1) { \
1847 TRACED_FAIL(); \
1848 } \
1849 traced_UnifyBound_TEST_ATTACHED(f, d0, ipt0, d1); \
1850 d0 = ArityOfFunctor(f); \
1851 always_save_pc(); \
1852 save_hb(); \
1853 if (IUnify_complex(ipt0, ipt0 + d0, ipt1)) { \
1854 always_set_pc(); \
1855 GONext(); \
1856 } else { \
1857 TRACED_FAIL(); \
1858 } \
1859 } else { \
1860 TRACED_FAIL(); \
1861 }
1862
1863/*
1864 * Next, HB
1865 */
1866#ifdef SHADOW_HB
1867#undef HBREG
1868#define set_hb() HBREG = HB
1869#define save_hb() HB = HBREG
1870#else
1871#define set_hb()
1872#define save_hb()
1873#endif
1874
1875typedef struct unif_record {
1876 CELL *ptr;
1877 Term old;
1878} unif_record;
1879
1880typedef struct v_record {
1881 CELL *start0;
1882 CELL *end0;
1883 CELL *start1;
1884 Term old;
1885} v_record;
1886
1887#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C) || defined(IN_TRACED_ABSMI_C)
1888
1889static int IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1) {
1890 CACHE_REGS
1891#ifdef THREADS
1892#undef Yap_REGS
1893 register REGSTORE *regp = Yap_regp;
1894#define Yap_REGS (*regp)
1895#elif defined(SHADOW_REGS)
1896#if defined(B) || defined(TR)
1897 register REGSTORE *regp = &Yap_REGS;
1898
1899#define Yap_REGS (*regp)
1900#endif /* defined(B) || defined(TR) || defined(HB) */
1901#endif
1902
1903#ifdef SHADOW_HB
1904 register CELL *HBREG = HB;
1905#endif /* SHADOW_HB */
1906
1907 struct unif_record *unif = (struct unif_record *)AuxBase;
1908 struct v_record *tovisit = (struct v_record *)AuxSp;
1909#define unif_base ((struct unif_record *)AuxBase)
1910#define tovisit_base ((struct v_record *)AuxSp)
1911
1912loop:
1913 while (pt0 < pt0_end) {
1914 register CELL *ptd0 = pt0 + 1;
1915 register CELL d0;
1916
1917 ++pt1;
1918 pt0 = ptd0;
1919 d0 = *ptd0;
1920 deref_head(d0, unify_comp_unk);
1921 unify_comp_nvar : {
1922 register CELL *ptd1 = pt1;
1923 register CELL d1 = *ptd1;
1924
1925 deref_head(d1, unify_comp_nvar_unk);
1926 unify_comp_nvar_nvar:
1927 if (d0 == d1)
1928 continue;
1929 if (IsPairTerm(d0)) {
1930 if (!IsPairTerm(d1)) {
1931 goto cufail;
1932 }
1933 /* now link the two structures so that no one else will */
1934 /* come here */
1935 /* store the terms to visit */
1936 if (RATIONAL_TREES || pt0 < pt0_end) {
1937 tovisit--;
1938#ifdef RATIONAL_TREES
1939 unif++;
1940#endif
1941 if ((void *)tovisit < (void *)unif) {
1942 CELL **urec = (CELL **)unif;
1943 tovisit = (struct v_record *)Yap_shift_visit((CELL **)tovisit,
1944 &urec, NULL);
1945 unif = (struct unif_record *)urec;
1946 }
1947 tovisit->start0 = pt0;
1948 tovisit->end0 = pt0_end;
1949 tovisit->start1 = pt1;
1950#ifdef RATIONAL_TREES
1951 unif[-1].old = *pt0;
1952 unif[-1].ptr = pt0;
1953 *pt0 = d1;
1954#endif
1955 }
1956 pt0_end = (pt0 = RepPair(d0) - 1) + 2;
1957 pt1 = RepPair(d1) - 1;
1958 continue;
1959 }
1960 if (IsApplTerm(d0)) {
1961 register Functor f;
1962 register CELL *ap2, *ap3;
1963
1964 if (!IsApplTerm(d1)) {
1965 goto cufail;
1966 }
1967 /* store the terms to visit */
1968 ap2 = RepAppl(d0);
1969 ap3 = RepAppl(d1);
1970 f = (Functor)(*ap2);
1971 /* compare functors */
1972 if (f != (Functor)*ap3)
1973 goto cufail;
1974 if (IsExtensionFunctor(f)) {
1975 if (unify_extension(f, d0, ap2, d1))
1976 continue;
1977 goto cufail;
1978 }
1979 /* now link the two structures so that no one else will */
1980 /* come here */
1981 /* store the terms to visit */
1982 if (RATIONAL_TREES || pt0 < pt0_end) {
1983 tovisit--;
1984#ifdef RATIONAL_TREES
1985 unif++;
1986#endif
1987 if ((void *)tovisit < (void *)unif) {
1988 CELL **urec = (CELL **)unif;
1989 tovisit = (struct v_record *)Yap_shift_visit((CELL **)tovisit,
1990 &urec, NULL);
1991 unif = (struct unif_record *)urec;
1992 }
1993 tovisit->start0 = pt0;
1994 tovisit->end0 = pt0_end;
1995 tovisit->start1 = pt1;
1996#ifdef RATIONAL_TREES
1997 unif[-1].old = *pt0;
1998 unif[-1].ptr = pt0;
1999 *pt0 = d1;
2000#endif
2001 }
2002 d0 = ArityOfFunctor(f);
2003 pt0 = ap2;
2004 pt0_end = ap2 + d0;
2005 pt1 = ap3;
2006 continue;
2007 }
2008 goto cufail;
2009
2010 derefa_body(d1, ptd1, unify_comp_nvar_unk, unify_comp_nvar_nvar);
2011 /* d1 and pt2 have the unbound value, whereas d0 is bound */
2012 Bind_Global(ptd1, d0);
2013 continue;
2014 }
2015
2016 derefa_body(d0, ptd0, unify_comp_unk, unify_comp_nvar);
2017 /* first arg var */
2018 {
2019 register CELL d1;
2020 register CELL *ptd1;
2021
2022 ptd1 = pt1;
2023 d1 = ptd1[0];
2024 /* pt2 is unbound */
2025 deref_head(d1, unify_comp_var_unk);
2026 unify_comp_var_nvar:
2027 /* pt2 is unbound and d1 is bound */
2028 Bind_Global(ptd0, d1);
2029 continue;
2030
2031 derefa_body(d1, ptd1, unify_comp_var_unk, unify_comp_var_nvar);
2032 /* ptd0 and ptd1 are unbound */
2033 UnifyGlobalCells(ptd0, ptd1);
2034 }
2035 }
2036 /* Do we still have compound terms to visit */
2037 if (tovisit < tovisit_base) {
2038 pt0 = tovisit->start0;
2039 pt0_end = tovisit->end0;
2040 pt1 = tovisit->start1;
2041 tovisit++;
2042 goto loop;
2043 }
2044#ifdef RATIONAL_TREES
2045 /* restore bindigs */
2046 while (unif-- != unif_base) {
2047 CELL *pt0;
2048
2049 pt0 = unif->ptr;
2050 *pt0 = unif->old;
2051 }
2052#endif
2053 return TRUE;
2054
2055cufail:
2056#ifdef RATIONAL_TREES
2057 /* restore bindigs */
2058 while (unif-- != unif_base) {
2059 CELL *pt0;
2060
2061 pt0 = unif->ptr;
2062 *pt0 = unif->old;
2063 }
2064#endif
2065 return FALSE;
2066#ifdef THREADS
2067#undef Yap_REGS
2068#define Yap_REGS (*Yap_regp)
2069#elif defined(SHADOW_REGS)
2070#if defined(B) || defined(TR)
2071#undef Yap_REGS
2072#endif /* defined(B) || defined(TR) */
2073#endif
2074}
2075
2076/* don't pollute name space */
2077#undef tovisit_base
2078#undef unif_base
2079
2080#endif
2081
2082#if /* defined(IN_ABSMI_C) ||*/ defined( \
2083 IN_INLINES_C) /*|| defined(IN_TRACED_ABSMI_C) */
2084
2085static int iequ_complex(register CELL *pt0, register CELL *pt0_end,
2086 register CELL *pt1) {
2087 CACHE_REGS
2088#ifdef THREADS
2089#undef Yap_REGS
2090 register REGSTORE *regp = Yap_regp;
2091#define Yap_REGS (*regp)
2092#elif defined(SHADOW_REGS)
2093#if defined(B) || defined(TR)
2094 register REGSTORE *regp = &Yap_REGS;
2095
2096#define Yap_REGS (*regp)
2097#endif /* defined(B) || defined(TR) || defined(HB) */
2098#endif
2099
2100#ifdef SHADOW_HB
2101 register CELL *HBREG = HB;
2102#endif /* SHADOW_HB */
2103
2104 struct unif_record *unif = (struct unif_record *)AuxBase;
2105 struct v_record *tovisit = (struct v_record *)AuxSp;
2106#define unif_base ((struct unif_record *)AuxBase)
2107#define tovisit_base ((struct v_record *)AuxSp)
2108
2109 loop:
2110 while (pt0 < pt0_end) {
2111 register CELL *ptd0 = pt0 + 1;
2112 register CELL d0;
2113
2114 ++pt1;
2115 pt0 = ptd0;
2116 d0 = *ptd0;
2117 deref_head(d0, iequ_comp_unk);
2118 iequ_comp_nvar : {
2119 register CELL *ptd1 = pt1;
2120 register CELL d1 = *ptd1;
2121
2122 deref_head(d1, iequ_comp_nvar_unk);
2123 iequ_comp_nvar_nvar:
2124 if (d0 == d1)
2125 continue;
2126 if (IsPairTerm(d0)) {
2127 if (!IsPairTerm(d1)) {
2128 goto cufail;
2129 }
2130 /* now link the two structures so that no one else will */
2131 /* come here */
2132 /* store the terms to visit */
2133 tovisit--;
2134 unif++;
2135 if ((void *)tovisit < (void *)unif) {
2136 CELL **urec = (CELL **)unif;
2137 tovisit = (struct v_record *)Yap_shift_visit((CELL **)tovisit,
2138 &urec, NULL);
2139 unif = (struct unif_record *)urec;
2140 }
2141 tovisit->start0 = pt0;
2142 tovisit->end0 = pt0_end;
2143 tovisit->start1 = pt1;
2144
2145 unif[-1].ptr = pt0;
2146 unif[-1].old = *pt0;
2147
2148
2149 *pt0 = d1;
2150 pt0_end = (pt0 = RepPair(d0) - 1) + 2;
2151 pt1 = RepPair(d1) - 1;
2152 continue;
2153 }
2154 if (IsApplTerm(d0)) {
2155 register Functor f;
2156 register CELL *ap2, *ap3;
2157
2158 if (!IsApplTerm(d1)) {
2159 goto cufail;
2160 }
2161 /* store the terms to visit */
2162 ap2 = RepAppl(d0);
2163 ap3 = RepAppl(d1);
2164 f = (Functor)(*ap2);
2165 /* compare functors */
2166 if (f != (Functor)*ap3)
2167 goto cufail;
2168 if (IsExtensionFunctor(f)) {
2169 if (unify_extension(f, d0, ap2, d1))
2170 continue;
2171 goto cufail;
2172 }
2173 /* now link the two structures so that no one else will */
2174 /* come here */
2175 /* store the terms to visit */
2176 tovisit--;
2177 unif++;
2178 if ((void *)tovisit < (void *)unif) {
2179 CELL **urec = (CELL **)unif;
2180 tovisit = (struct v_record *)Yap_shift_visit((CELL **)tovisit,
2181 &urec, NULL);
2182 unif = (struct unif_record *)urec;
2183 }
2184 tovisit->start0 = pt0;
2185 tovisit->end0 = pt0_end;
2186 tovisit->start1 = pt1;
2187 unif[-1].old = *pt0;
2188 unif[-1].ptr = pt0;
2189 *pt0 = d1;
2190 d0 = ArityOfFunctor(f);
2191 pt0 = ap2;
2192 pt0_end = ap2 + d0;
2193 pt1 = ap3;
2194 continue;
2195 }
2196 goto cufail;
2197
2198 derefa_body(d1, ptd1, iequ_comp_nvar_unk, iequ_comp_nvar_nvar);
2199 goto cufail;
2200
2201 derefa_body(d0, ptd0, iequ_comp_unk, iequ_comp_nvar);
2202 /* first arg var */
2203 {
2204 register CELL d1;
2205 register CELL *ptd1;
2206
2207 ptd1 = pt1;
2208 d1 = ptd1[0];
2209 /* pt2 is unbound */
2210 deref_head(d1, iequ_comp_var_unk);
2211 iequ_comp_var_nvar:
2212 /* pt2 is unbound and d1 is bound */
2213 goto cufail;
2214
2215 derefa_body(d1, ptd1, iequ_comp_var_unk, iequ_comp_var_nvar);
2216 /* pt2 and pt3 are unbound */
2217 if (ptd0 == ptd1)
2218 continue;
2219 goto cufail;
2220
2221 }
2222 }
2223 }
2224 /* Do we still have compound terms to visit */
2225 if (tovisit < tovisit_base) {
2226 pt0 = tovisit->start0;
2227 pt0_end = tovisit->end0;
2228 pt1 = tovisit->start1;
2229 tovisit++;
2230 goto loop;
2231 }
2232
2233 /* restore bindigs */
2234 while (unif-- != unif_base) {
2235 CELL *pt0;
2236
2237 pt0 = unif->ptr;
2238 *pt0 = unif->old;
2239 }
2240 return TRUE;
2241
2242cufail:
2243#ifdef RATIONAL_TREES
2244 /* restore bindigs */
2245 while (unif-- != unif_base) {
2246 CELL *pt0;
2247
2248 pt0 = unif->ptr;
2249 *pt0 = unif->old;
2250 }
2251#endif
2252 return FALSE;
2253#ifdef THREADS
2254#undef Yap_REGS
2255#define Yap_REGS (*Yap_regp)
2256#elif defined(SHADOW_REGS)
2257#if defined(B) || defined(TR)
2258#undef Yap_REGS
2259#endif /* defined(B) || defined(TR) */z
2260#endif
2261 }
2262
2263#endif
2264
2265static inline wamreg Yap_regnotoreg(UInt regnbr) {
2266#if PRECOMPUTE_REGADDRESS
2267 return (wamreg)(XREGS + regnbr);
2268#else
2269#if MSHIFTOFFS
2270 return regnbr;
2271#else
2272 return CELLSIZE * regnbr;
2273#endif
2274#endif /* ALIGN_LONGS */
2275}
2276
2277static inline UInt Yap_regtoregno(wamreg reg) {
2278#if PRECOMPUTE_REGADDRESS
2279 return ((CELL *)reg) - XREGS;
2280#else
2281#if MSHIFTOFFS
2282 return reg;
2283#else
2284 return reg / CELLSIZE;
2285#endif
2286#endif /* ALIGN_LONGS */
2287}
2288
2289#ifdef DEPTH_LIMIT
2290#define check_depth(DEPTH, ap) \
2291 if ((DEPTH) <= MkIntTerm(1)) { /* I assume Module==0 is prolog */ \
2292 if ((ap)->ModuleOfPred) { \
2293 if ((DEPTH) == MkIntTerm(0)) { \
2294 FAIL(); \
2295 } else \
2296 (DEPTH) = RESET_DEPTH(); \
2297 } \
2298 } else if ((ap)->ModuleOfPred) \
2299 (DEPTH) -= MkIntConstant(2);
2300#else
2301#define check_depth(DEPTH, ap)
2302#endif
2303
2304#if defined(THREADS) || defined(YAPOR)
2305#define copy_jmp_address(X) (PREG_ADDR = &(X))
2306#define copy_jmp_addressa(X) (PREG_ADDR = (yamop **)(X))
2307#else
2308#define copy_jmp_address(X)
2309#define copy_jmp_addressa(X)
2310#endif
2311
2312static inline void prune(choiceptr cp USES_REGS) {
2313#ifdef YAPOR
2314 CUT_prune_to(cp);
2315#endif /* YAPOR */
2316 if (B >= cp)
2317 return;
2318 if (SHOULD_CUT_UP_TO(B, cp)) {
2319 if (ASP > (CELL *)PROTECT_FROZEN_B(B))
2320 ASP = (CELL *)PROTECT_FROZEN_B(B);
2321 while (B->cp_b < cp) {
2322 if (B->cp_b == NULL)
2323 return;
2324 B = B->cp_b;
2325 }
2326 /* cut ! */
2327#ifdef TABLING
2328 abolish_incomplete_subgoals(B);
2329#endif /* TABLING */
2330 HB = PROTECT_FROZEN_H(B->cp_b);
2331#include "trim_trail.h"
2332 B = B->cp_b;
2333 SET_BB(PROTECT_FROZEN_B(B));
2334 }
2335}
2336
2337#if YAPOR
2338#define INITIALIZE_PERMVAR(PTR, V) Bind_Local((PTR), (V))
2339#else
2340#define INITIALIZE_PERMVAR(PTR, V) *(PTR) = (V)
2341#endif
2342
2343/* l1: bind a, l2 bind b, l3 no binding */
2344#define UnifyAndTrailCells(a, b) \
2345 if ((a) > (b)) { \
2346 if ((a) < HR) { \
2347 *(a) = (CELL)(b); \
2348 DO_TRAIL((a), (CELL)(b)); \
2349 } else if ((b) <= HR) { \
2350 *(a) = (CELL)(b); \
2351 DO_TRAIL((a), (CELL)(b)); \
2352 } else { \
2353 *(b) = (CELL)(a); \
2354 DO_TRAIL((b), (CELL)(a)); \
2355 } \
2356 } else if ((a) < (b)) { \
2357 if ((b) <= HR) { \
2358 *(b) = (CELL)(a); \
2359 DO_TRAIL((b), (CELL)(a)); \
2360 } else if ((a) <= HR) { \
2361 *(b) = (CELL)(a); \
2362 DO_TRAIL((b), (CELL)(a)); \
2363 } else { \
2364 *(a) = (CELL)(b); \
2365 DO_TRAIL((a), (CELL)(b)); \
2366 } \
2367 }
2368
2369#define CHECK_ALARM(CONT)
2370
2371#if HAVE_SYS_TIME_H
2372#include <sys/time.h>
2373#endif
2374#if HAVE_SYS_RESOURCE_H
2375#include <sys/resource.h>
2376#endif
2377
2378#if YAP_JIT
2379
2380extern Environment ExpEnv;
2381extern char fin[1024];
2382
2383#ifndef _NATIVE
2384
2385#include <math.h>
2386
2387#ifndef __cplusplus
2388#include "JIT_Compiler.hpp"
2389
2390void *(*Yap_JitCall)(JIT_Compiler *jc, yamop *p);
2391void (*Yap_llvmShutdown)(void);
2392Int (*Yap_traced_absmi)(void);
2393extern JIT_Compiler *J;
2394#endif
2395
2396
2397extern NativeContext *NativeArea;
2398extern IntermediatecodeContext *IntermediatecodeArea;
2399
2400extern CELL l;
2401extern short global;
2402extern CELL nnexec;
2403extern yamop *HEADPREG;
2404extern CELL BLOCK;
2405extern CELL BLOCKADDRESS;
2406extern CELL FAILED;
2407
2408extern TraceContext **curtrace;
2409extern yamop *curpreg;
2410extern BlocksContext **globalcurblock;
2411extern COUNT ineedredefinedest;
2412extern yamop *headoftrace;
2413
2414#endif /* _NATIVE */
2415#endif /* YAP_JIT */
2416
2417#ifdef SHADOW_S
2418#define PROCESS_INT(F, C) \
2419 BEGD(d0); \
2420 Yap_REGS.S_ = SREG; \
2421 saveregs(); \
2422 d0 = F(PASS_REGS1); \
2423 setregs(); \
2424 SREG = Yap_REGS.S_; \
2425 if (!d0) \
2426 FAIL(); \
2427 PP = NULL; \
2428 set_pc();\ \
2429 CACHE_A1();\
2430 ENDD(d0);
2431#else
2432#define PROCESS_INT(F, C) \
2433 { \
2434 saveregs(); \
2435 int rc= F(PASS_REGS1); \
2436 setregs(); \
2437 if (rc == 0) { \
2438 FAIL(); \
2439 /* goto C;*/ \
2440 set_pc(); \
2441 CACHE_A1();\
2442 ENDD(d0); \
2443}
2444#endif
2445
2447#define INT_HANDLER_GO_ON -1
2448#define INT_HANDLER_FAIL 0
2449#define INT_HANDLER_RET_NEXT 1
2450#define INT_HANDLER_RET_JMP 2
2451#define HAS_INT(D) (D>=0)
2452
2453
2454#define PROCESS_INTERRUPTED_PRUNE(F) \
2455 { \
2456 saveregs(); \
2457 PREG = P = F(PASS_REGS1); \
2458 setregs(); \
2459 CACHE_A1();\
2460 } \
2461 JMPNext();
2462
2463
2464#define Yap_AsmError(e, d) \
2465 { \
2466 saveregs(); \
2467 Yap_ThrowError(e, d, "while executing inlined built-in"); \
2468 setregs(); \
2469 }
2470
2471#endif // ABSMI_H
Yap.h
Main definitions.
regstore_t
Definition: Regs.h:94
unif_record
Definition: absmi.h:1875
v_record
Definition: absmi.h:1880
yami
Definition: amidefs.h:264