2292 lines
61 KiB
C
Executable File
2292 lines
61 KiB
C
Executable File
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: absmi.c *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: Portable abstract machine interpreter includes *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
#ifndef ABSMI_H
|
|
|
|
#define ABSMI_H 1
|
|
|
|
#if NATIVE_EXECUTION
|
|
/* just a stub */
|
|
#else
|
|
#define EXEC_NATIVE(X)
|
|
#define MAX_INVOCATION 1024
|
|
#define Yapc_Compile(P) 0
|
|
#endif
|
|
|
|
#ifdef __cplusplus
|
|
#define register
|
|
#endif
|
|
|
|
|
|
/***************************************************************
|
|
* Macros for register manipulation *
|
|
***************************************************************/
|
|
/*
|
|
* Machine and compiler dependent definitions
|
|
*/
|
|
#ifdef __GNUC__
|
|
|
|
#ifdef hppa
|
|
#define SHADOW_P 1
|
|
#define SHADOW_Y 1
|
|
#define SHADOW_REGS 1
|
|
#define USE_PREFETCH 1
|
|
#endif
|
|
|
|
#ifdef __alpha
|
|
#define SHADOW_P 1
|
|
#define SHADOW_Y 1
|
|
#define SHADOW_REGS 1
|
|
#define USE_PREFETCH 1
|
|
#endif
|
|
|
|
#ifdef mips
|
|
#define SHADOW_P 1
|
|
#define SHADOW_Y 1
|
|
#define SHADOW_REGS 1
|
|
#define USE_PREFETCH 1
|
|
#endif
|
|
|
|
#if defined(_POWER) || defined(__POWERPC__)
|
|
#define SHADOW_P 1
|
|
#define SHADOW_REGS 1
|
|
#define USE_PREFETCH 1
|
|
#endif
|
|
|
|
#ifdef i386
|
|
#define Y_IN_MEM 1
|
|
#define S_IN_MEM 1
|
|
#define TR_IN_MEM 1
|
|
#define HAVE_FEW_REGS 1
|
|
#define LIMITED_PREFETCH 1
|
|
#ifdef BP_FREE
|
|
/***************************************************************
|
|
* Use bp as PREG for X86 machines *
|
|
***************************************************************/
|
|
#if defined(IN_ABSMI_C)
|
|
register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
|
|
#define PREG P1REG
|
|
#endif
|
|
#define NEEDS_TO_SET_PC 1
|
|
#endif /* BP_FREE */
|
|
#endif /* i386 */
|
|
|
|
#ifdef sparc
|
|
#define SHADOW_P 1
|
|
#ifdef BP_FREE
|
|
#undef BP_FREE
|
|
#endif
|
|
#define S_IN_MEM 1
|
|
#define Y_IN_MEM 1
|
|
#define TR_IN_MEM 1
|
|
#endif /* sparc_ */
|
|
|
|
#ifdef __x86_64__
|
|
#define SHADOW_P 1
|
|
#ifdef BP_FREE
|
|
#undef BP_FREE
|
|
#endif
|
|
#define SHADOW_S 1
|
|
//#define SHADOW_Y 1
|
|
#define S_IN_MEM 1
|
|
#define Y_IN_MEM 1
|
|
#define TR_IN_MEM 1
|
|
#define LIMITED_PREFETCH 1
|
|
#endif /* __x86_64__ */
|
|
|
|
#if defined(__arm__) || defined(__thumb__)
|
|
|
|
#define Y_IN_MEM 1
|
|
#define S_IN_MEM 1
|
|
#define TR_IN_MEM 1
|
|
#define HAVE_FEW_REGS 1
|
|
#endif
|
|
|
|
#else /* other compilers */
|
|
|
|
#define S_IN_MEM 1
|
|
|
|
/* This works for xlc under AIX 3.2.5 */
|
|
#ifdef _IBMR2
|
|
#define SHADOW_P 1
|
|
#define SHADOW_REGS 1
|
|
#define SHADOW_S 1
|
|
#endif
|
|
|
|
#ifdef i386
|
|
#define Y_IN_MEM 1
|
|
#define S_IN_MEM 1
|
|
#define TR_IN_MEM 1
|
|
#define HAVE_FEW_REGS 1
|
|
#endif
|
|
|
|
#ifdef mips
|
|
#define SHADOW_P 1
|
|
#define SHADOW_Y 1
|
|
#define SHADOW_S 1
|
|
#define SHADOW_CP 1
|
|
#define SHADOW_HB 1
|
|
#define USE_PREFETCH 1
|
|
#endif
|
|
|
|
#ifdef _HPUX_SOURCE
|
|
#define SHADOW_P 1
|
|
#define SHADOW_Y 1
|
|
#define SHADOW_S 1
|
|
#define SHADOW_CP 1
|
|
#define SHADOW_HB 1
|
|
#define USE_PREFETCH 1
|
|
#endif
|
|
|
|
#endif /* __GNUC__ */
|
|
|
|
#include "Yap.h"
|
|
#include "clause.h"
|
|
#include "eval.h"
|
|
#ifdef HAVE_STRING_H
|
|
#include <string.h>
|
|
#endif
|
|
#if YAP_JIT
|
|
#include "amijit.h"
|
|
#endif
|
|
#ifdef YAPOR
|
|
#include "or.macros.h"
|
|
#endif /* YAPOR */
|
|
#ifdef USE_SYSTEM_MALLOC
|
|
#include "YapHeap.h"
|
|
#endif
|
|
#ifdef TABLING
|
|
#include "tab.macros.h"
|
|
#endif /* TABLING */
|
|
#ifdef LOW_LEVEL_TRACER
|
|
#include "tracer.h"
|
|
#endif
|
|
|
|
#ifdef DEBUG
|
|
/**********************************************************************
|
|
* *
|
|
* Debugging Auxiliary variables *
|
|
* *
|
|
**********************************************************************/
|
|
#include <stdio.h>
|
|
#endif
|
|
|
|
#if PUSH_REGS
|
|
|
|
/***************************************************************
|
|
* Trick to copy REGS into absmi local environment *
|
|
***************************************************************/
|
|
INLINE_ONLY inline EXTERN void
|
|
init_absmi_regs(REGSTORE * absmi_regs);
|
|
|
|
/* regp is a global variable */
|
|
|
|
INLINE_ONLY inline EXTERN void
|
|
init_absmi_regs(REGSTORE * absmi_regs)
|
|
{
|
|
CACHE_REGS
|
|
memcpy(absmi_regs, Yap_regp, sizeof(REGSTORE));
|
|
}
|
|
|
|
INLINE_ONLY inline EXTERN void
|
|
restore_absmi_regs(REGSTORE * old_regs);
|
|
|
|
|
|
INLINE_ONLY inline EXTERN void
|
|
restore_absmi_regs(REGSTORE * old_regs)
|
|
{
|
|
CACHE_REGS
|
|
memcpy(old_regs, Yap_regp, sizeof(REGSTORE));
|
|
#ifdef THREADS
|
|
pthread_setspecific(Yap_yaamregs_key, (void *)old_regs);
|
|
LOCAL_ThreadHandle.current_yaam_regs = old_regs;
|
|
#else
|
|
Yap_regp = old_regs;
|
|
#endif
|
|
}
|
|
#endif /* PUSH_REGS */
|
|
|
|
/*****************************************************************
|
|
|
|
Machine Dependent stuff
|
|
|
|
******************************************************************/
|
|
|
|
#ifdef LONG_LIVED_REGISTERS
|
|
|
|
#define BEGP(TMP)
|
|
|
|
#define ENDP(TMP)
|
|
|
|
#define BEGD(TMP)
|
|
|
|
#define ENDD(TMP)
|
|
|
|
#else
|
|
|
|
#define BEGP(TMP) { register CELL *TMP
|
|
|
|
#define ENDP(TMP) }
|
|
|
|
#define BEGD(TMP) { register CELL TMP
|
|
|
|
#define ENDD(TMP) }
|
|
|
|
#endif /* LONG_LIVED_REGISTERS */
|
|
|
|
#define BEGCHO(TMP) { register choiceptr TMP
|
|
|
|
#define ENDCHO(TMP) }
|
|
|
|
/***************************************************************
|
|
* YREG is usually, but not always, a register. This affects *
|
|
* choicepoints *
|
|
***************************************************************/
|
|
|
|
#if Y_IN_MEM
|
|
|
|
#define CACHE_Y(A) { register CELL *S_YREG = ((CELL *)(A))
|
|
|
|
#define ENDCACHE_Y() YREG = S_YREG; }
|
|
|
|
#define B_YREG ((choiceptr)(S_YREG))
|
|
|
|
#else
|
|
|
|
#define S_YREG (YREG)
|
|
|
|
#define B_YREG ((choiceptr)(YREG))
|
|
|
|
#define CACHE_Y(A) { YREG = ((CELL *)(A))
|
|
|
|
#define ENDCACHE_Y() }
|
|
|
|
#endif
|
|
|
|
#if Y_IN_MEM
|
|
|
|
#define CACHE_Y_AS_ENV(A) { register CELL *ENV_YREG = (A)
|
|
|
|
#define FETCH_Y_FROM_ENV(A) ENV_YREG = (A)
|
|
|
|
#define WRITEBACK_Y_AS_ENV() YREG = ENV_YREG
|
|
|
|
#define ENDCACHE_Y_AS_ENV() }
|
|
|
|
#define saveregs_and_ycache() YREG = ENV_YREG; saveregs()
|
|
|
|
#define setregs_and_ycache() ENV_YREG = YREG; setregs()
|
|
|
|
#else
|
|
|
|
#define ENV_YREG (YREG)
|
|
|
|
#define WRITEBACK_Y_AS_ENV()
|
|
|
|
#define CACHE_Y_AS_ENV(A) { YREG = (A)
|
|
|
|
#define FETCH_Y_FROM_ENV(A) (A)
|
|
|
|
#define ENDCACHE_Y_AS_ENV() }
|
|
|
|
#define saveregs_and_ycache() saveregs()
|
|
|
|
#define setregs_and_ycache() setregs()
|
|
|
|
#endif
|
|
|
|
#if S_IN_MEM
|
|
|
|
#define CACHE_A1()
|
|
|
|
#define CACHED_A1() ARG1
|
|
|
|
#else
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#define CACHE_A1() (SREG = (CELL *)ARG1)
|
|
|
|
#define CACHED_A1() ((CELL)SREG)
|
|
|
|
#else
|
|
|
|
#define CACHE_A1() ((*_SREG) = (CELL *)ARG1)
|
|
|
|
#define CACHED_A1() ((CELL)(*_SREG))
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#endif /* S_IN_MEM */
|
|
|
|
/***************************************************************
|
|
* TR is usually, but not always, a register. This affects *
|
|
* backtracking *
|
|
***************************************************************/
|
|
|
|
#ifdef _NATIVE
|
|
|
|
#define CACHE_TR(A) register tr_fr_ptr S_TR = (A)
|
|
|
|
#define RESTORE_TR() TR = S_TR
|
|
|
|
#define ENDCACHE_TR()
|
|
|
|
#else
|
|
|
|
#define CACHE_TR(A) { register tr_fr_ptr S_TR = (A)
|
|
|
|
#define RESTORE_TR() TR = S_TR
|
|
|
|
#define ENDCACHE_TR() }
|
|
|
|
#endif
|
|
|
|
/***************************************************************
|
|
* S is usually, but not always, a register (X86 machines). *
|
|
* This affects unification instructions *
|
|
***************************************************************/
|
|
|
|
#if S_IN_MEM
|
|
|
|
/* jump through hoops because idiotic gcc will go and read S from
|
|
memory every time it uses S :-( */
|
|
|
|
#define CACHE_S() { register CELL * S_SREG;
|
|
|
|
#define ENDCACHE_S() }
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#define READ_IN_S() S_SREG = SREG
|
|
|
|
#else
|
|
|
|
#define READ_IN_S() S_SREG = *_SREG
|
|
|
|
#endif
|
|
|
|
#else
|
|
|
|
/* do nothing if you are on a decent machine */
|
|
|
|
#define CACHE_S() {
|
|
|
|
#define ENDCACHE_S() }
|
|
|
|
#define READ_IN_S()
|
|
|
|
#define S_SREG SREG
|
|
|
|
#endif
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#define WRITEBACK_S(X) SREG = (X)
|
|
|
|
#else
|
|
|
|
#define WRITEBACK_S(X) *_SREG = (X)
|
|
|
|
#endif
|
|
|
|
/*****************************************************************
|
|
|
|
End of Machine Dependent stuff
|
|
|
|
******************************************************************/
|
|
|
|
/*****************************************************************
|
|
|
|
Prefetch is a technique to obtain the place to jump to before actually
|
|
executing instructions. It can speed up some machines, by having the
|
|
next opcode in place before it is actually required for jumping.
|
|
|
|
******************************************************************/
|
|
|
|
#if __YAP_TRACED
|
|
|
|
#define DO_PREFETCH(TYPE)
|
|
|
|
#define DO_PREFETCH_W(TYPE)
|
|
|
|
#elif USE_THREADED_CODE
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#if YAP_JIT
|
|
|
|
#define DO_PREFETCH(TYPE) \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
to_go = (void *) OpAddress[Yap_op_from_opcode(NEXTOP(PREG,TYPE)->opc) + ExpEnv.config_struc.current_displacement]; \
|
|
else \
|
|
to_go = (void *)(NEXTOP(PREG,TYPE)->opc);
|
|
|
|
#define DO_PREFETCH_W(TYPE) \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
to_go = (void *)OpAddress[Yap_op_from_opcode(NEXTOP(PREG,TYPE)->y_u.o.opcw) + ExpEnv.config_struc.current_displacement]; \
|
|
else \
|
|
to_go = (void *)(NEXTOP(PREG,TYPE)->y_u.o.opcw);
|
|
|
|
#else /* YAP_JIT */
|
|
|
|
#define DO_PREFETCH(TYPE) to_go = (void *)(NEXTOP(PREG,TYPE)->opc)
|
|
|
|
#define DO_PREFETCH_W(TYPE) to_go = (void *)(NEXTOP(PREG,TYPE)->y_u.o.opcw)
|
|
|
|
#endif /* YAP_JIT */
|
|
|
|
#else /* _NATIVE */
|
|
|
|
#define DO_PREFETCH(TYPE)
|
|
|
|
#define DO_PREFETCH_W(TYPE)
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#if LIMITED_PREFETCH||USE_PREFETCH
|
|
|
|
#define ALWAYS_START_PREFETCH(TYPE) \
|
|
{ register void *to_go; DO_PREFETCH(TYPE)
|
|
|
|
#if YAP_JIT
|
|
#define ALWAYS_LOOKAHEAD(WHAT) \
|
|
{ \
|
|
register void *to_go; \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
to_go = (void *) OpAddress[Yap_op_from_opcode(WHAT) + ExpEnv.config_struc.current_displacement]; \
|
|
else \
|
|
to_go = (void *)(WHAT);
|
|
#else /* YAP_JIT */
|
|
#define ALWAYS_LOOKAHEAD(WHAT) \
|
|
{ register void *to_go = (void *)(WHAT);
|
|
#endif /* YAP_JIT */
|
|
|
|
#define ALWAYS_START_PREFETCH_W(TYPE) \
|
|
{ register void *to_go; DO_PREFETCH_W(TYPE)
|
|
|
|
#else
|
|
|
|
#define ALWAYS_START_PREFETCH(TYPE) {
|
|
|
|
#define ALWAYS_START_PREFETCH_W(TYPE) {
|
|
|
|
#define ALWAYS_LOOKAHEAD(WHERE) {
|
|
|
|
#endif /* LIMITED_PREFETCH||USE_PREFETCH */
|
|
|
|
#else /* _NATIVE */
|
|
|
|
#if LIMITED_PREFETCH||USE_PREFETCH
|
|
|
|
#define ALWAYS_START_PREFETCH(TYPE)
|
|
|
|
#define ALWAYS_LOOKAHEAD(WHAT)
|
|
|
|
#define ALWAYS_START_PREFETCH_W(TYPE)
|
|
|
|
#else
|
|
|
|
#define ALWAYS_START_PREFETCH(TYPE)
|
|
|
|
#define ALWAYS_START_PREFETCH_W(TYPE)
|
|
|
|
#define ALWAYS_LOOKAHEAD(WHERE)
|
|
|
|
#endif /* LIMITED_PREFETCH||USE_PREFETCH */
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#ifdef USE_PREFETCH
|
|
|
|
#define START_PREFETCH(TYPE) ALWAYS_START_PREFETCH(TYPE)
|
|
|
|
#define START_PREFETCH_W(TYPE) ALWAYS_START_PREFETCH_W(TYPE)
|
|
|
|
#define INIT_PREFETCH() \
|
|
{ register void *to_go;
|
|
|
|
#define PREFETCH_OP(X) \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
to_go = (void *) OpAddress[Yap_op_from_opcode((X)->opc) + ExpEnv.config_struc.current_displacement]; \
|
|
else \
|
|
to_go = (void *)((X)->opc);
|
|
|
|
#else
|
|
|
|
#define START_PREFETCH(TYPE) {
|
|
|
|
#define START_PREFETCH_W(TYPE) {
|
|
|
|
#define INIT_PREFETCH() {
|
|
|
|
#define PREFETCH_OP(X)
|
|
|
|
#endif /* USE_PREFETCH */
|
|
|
|
#else /* _NATIVE */
|
|
|
|
#ifdef USE_PREFETCH
|
|
|
|
#define START_PREFETCH(TYPE) ALWAYS_START_PREFETCH(TYPE)
|
|
|
|
#define START_PREFETCH_W(TYPE) ALWAYS_START_PREFETCH_W(TYPE)
|
|
|
|
#define INIT_PREFETCH()
|
|
|
|
#define PREFETCH_OP(X)
|
|
|
|
#else
|
|
|
|
#define START_PREFETCH(TYPE)
|
|
|
|
#define START_PREFETCH_W(TYPE)
|
|
|
|
#define INIT_PREFETCH()
|
|
|
|
#define PREFETCH_OP(X)
|
|
|
|
#endif /* USE_PREFETCH */
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#else /* USE_THREADED_CODE */
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#define ALWAYS_START_PREFETCH(TYPE) {
|
|
|
|
#define ALWAYS_START_PREFETCH_W(TYPE) {
|
|
|
|
#define ALWAYS_LOOKAHEAD(WHERE) {
|
|
|
|
#define START_PREFETCH(TYPE) {
|
|
|
|
#define START_PREFETCH_W(TYPE) {
|
|
|
|
#define INIT_PREFETCH() {
|
|
|
|
#define PREFETCH_OP(X)
|
|
|
|
#else
|
|
|
|
#define ALWAYS_START_PREFETCH(TYPE)
|
|
|
|
#define ALWAYS_START_PREFETCH_W(TYPE)
|
|
|
|
#define ALWAYS_LOOKAHEAD(WHERE)
|
|
|
|
#define START_PREFETCH(TYPE)
|
|
|
|
#define START_PREFETCH_W(TYPE)
|
|
|
|
#define INIT_PREFETCH()
|
|
|
|
#define PREFETCH_OP(X)
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#endif /* USE_THREADED_CODE */
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#define ALWAYS_END_PREFETCH() }
|
|
|
|
#define ALWAYS_END_PREFETCH_W() }
|
|
|
|
#define END_PREFETCH() }
|
|
|
|
#define END_PREFETCH_W() }
|
|
|
|
#else
|
|
|
|
#define ALWAYS_END_PREFETCH()
|
|
|
|
#define ALWAYS_END_PREFETCH_W()
|
|
|
|
#define END_PREFETCH()
|
|
|
|
#define END_PREFETCH_W()
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
/*****************************************************************
|
|
|
|
How to jump to the next abstract machine instruction
|
|
|
|
******************************************************************/
|
|
|
|
#if __YAP_TRACED
|
|
|
|
#define JMP(Lab) { opcode = Yap_op_from_opcode( goto *Lab ); goto op_switch; }
|
|
|
|
#define JMPNext(Lab) { opcode = Yap_op_from_opcode( PREG->opc ) + ExpEnv.config_struc.current_displacement; goto op_switch; }
|
|
|
|
#define JMPNextW(Lab) { opcode = Yap_op_from_opcode( PREG->opcw ) + ExpEnv.config_struc.current_displacement; goto op_switch; }
|
|
|
|
|
|
|
|
#elif USE_THREADED_CODE
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#define JMP(Lab) goto *Lab;
|
|
|
|
#if YAP_JIT
|
|
|
|
#define JMPNext() \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
JMP((void *) OpAddress[Yap_op_from_opcode(PREG->opc) + ExpEnv.config_struc.current_displacement]); \
|
|
JMP((void *) (PREG->opc));
|
|
|
|
#define JMPNextW() \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
JMP((void *) OpAddress[Yap_op_from_opcode(PREG->y_u.o.opcw) + ExpEnv.config_struc.current_displacement]); \
|
|
JMP((void *) (PREG->y_u.o.opcw));
|
|
|
|
#else /* YAP_JIT */
|
|
|
|
#define JMPNext() \
|
|
JMP((void *) (PREG->opc));
|
|
|
|
#define JMPNextW() \
|
|
JMP((void *) (PREG->y_u.o.opcw));
|
|
|
|
#endif /* YAP_JIT */
|
|
|
|
#else /* _NATIVE */
|
|
|
|
#if YAP_STAT_PREDS
|
|
|
|
#if YAP_DBG_PREDS
|
|
|
|
#define SUCCESSBACK() \
|
|
{ \
|
|
if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
|
|
if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
|
|
void* (*callee)(yamop**,yamop**,CELL**,void*[],void*[]); \
|
|
void* go; \
|
|
callee = (void*(*)(yamop**,yamop**,CELL**,void*[],void*[]))NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
|
|
go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, OpAddress); \
|
|
return go; \
|
|
} \
|
|
} \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != 0 && (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success); \
|
|
} \
|
|
HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
|
|
NativeArea->success[HEADPREG->y_u.jhc.jh->caa.naddress] += 1; \
|
|
(ExpEnv.config_struc.torecompile) ? (ExpEnv.config_struc.current_displacement = ExpEnv.config_struc.TOTAL_OF_OPCODES) \
|
|
: (ExpEnv.config_struc.current_displacement = 0); \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc) + ExpEnv.config_struc.current_displacement]); \
|
|
return ((void *) ((*_PREG)->opc)); \
|
|
}
|
|
|
|
#define BACK() \
|
|
{ \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != 0 && (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail); \
|
|
} \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); \
|
|
}
|
|
|
|
#else /* YAP_DBG_PREDS */
|
|
|
|
#define SUCCESSBACK() \
|
|
{ \
|
|
if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
|
|
if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
|
|
void* (*callee)(yamop**,yamop**,CELL**,void*[],void*[]); \
|
|
void* go; \
|
|
callee = (void*(*)(yamop**,yamop**,CELL**,void*[],void*[]))NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
|
|
go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, OpAddress); \
|
|
return go; \
|
|
} \
|
|
} \
|
|
HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
|
|
NativeArea->success[HEADPREG->y_u.jhc.jh->caa.naddress] += 1; \
|
|
(ExpEnv.config_struc.torecompile) ? (ExpEnv.config_struc.current_displacement = ExpEnv.config_struc.TOTAL_OF_OPCODES) \
|
|
: (ExpEnv.config_struc.current_displacement = 0); \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc) + ExpEnv.config_struc.current_displacement]); \
|
|
return ((void *) ((*_PREG)->opc)); \
|
|
}
|
|
|
|
#define BACK() \
|
|
{ \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); \
|
|
}
|
|
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
#else /* YAP_STAT_PREDS */
|
|
|
|
#if YAP_DBG_PREDS
|
|
|
|
#define SUCCESSBACK() \
|
|
{ \
|
|
if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
|
|
if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
|
|
void* (*callee)(yamop**,yamop**,CELL**,void*[],void*[]); \
|
|
void* go; \
|
|
callee = (void*(*)(yamop**,yamop**,CELL**,void*[],void*[]))NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
|
|
go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, OpAddress); \
|
|
return go; \
|
|
} \
|
|
} \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != 0 && (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_success); \
|
|
} \
|
|
HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
|
|
(ExpEnv.config_struc.torecompile) ? (ExpEnv.config_struc.current_displacement = ExpEnv.config_struc.TOTAL_OF_OPCODES) \
|
|
: (ExpEnv.config_struc.current_displacement = 0); \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc) + ExpEnv.config_struc.current_displacement]); \
|
|
return ((void *) ((*_PREG)->opc)); \
|
|
}
|
|
|
|
#define BACK() \
|
|
{ \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != 0 && (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.nativerun_exit_by_fail); \
|
|
} \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); \
|
|
}
|
|
|
|
#else /* YAP_DBG_PREDS */
|
|
|
|
#define SUCCESSBACK() \
|
|
{ \
|
|
if (Yap_op_from_opcode((*_PREG)->opc) == _jit_handler) { \
|
|
if ((*_PREG)->y_u.jhc.jh->caa.naddress != -1 && NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress] && NativeArea->area.ok[(*_PREG)->y_u.jhc.jh->caa.naddress]) { \
|
|
void* (*callee)(yamop**,yamop**,CELL**,void*[],void*[]); \
|
|
void* go; \
|
|
callee = (void*(*)(yamop**,yamop**,CELL**,void*[],void*[]))NativeArea->area.p[(*_PREG)->y_u.jhc.jh->caa.naddress]; \
|
|
go = (*callee)(&(*_PREG), &(*_CPREG), &(*_SREG), external_labels, OpAddress); \
|
|
return go; \
|
|
} \
|
|
} \
|
|
HEADPREG->y_u.jhc.jh->jitman.torecomp = ExpEnv.config_struc.torecompile; \
|
|
(ExpEnv.config_struc.torecompile) ? (ExpEnv.config_struc.current_displacement = ExpEnv.config_struc.TOTAL_OF_OPCODES) \
|
|
: (ExpEnv.config_struc.current_displacement = 0); \
|
|
if (ExpEnv.config_struc.current_displacement) \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc) + ExpEnv.config_struc.current_displacement]); \
|
|
return ((void *) ((*_PREG)->opc)); \
|
|
}
|
|
|
|
#define BACK() \
|
|
{ \
|
|
return ((void *) OpAddress[Yap_op_from_opcode((*_PREG)->opc)]); \
|
|
}
|
|
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
#endif /* YAP_STAT_PREDS */
|
|
|
|
#define JMP(Lab)
|
|
|
|
#define JMPNext()
|
|
|
|
#define JMPNextW()
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#if USE_THREADED_CODE && (LIMITED_PREFETCH || USE_PREFETCH)
|
|
|
|
#define ALWAYS_GONext() JMP(to_go)
|
|
|
|
#define ALWAYS_GONextW() JMP(to_go)
|
|
|
|
#else
|
|
|
|
#define ALWAYS_GONext() JMPNext()
|
|
|
|
#define ALWAYS_GONextW() JMPNextW()
|
|
|
|
#endif
|
|
|
|
#ifdef USE_PREFETCH
|
|
|
|
#define GONext() ALWAYS_GONext()
|
|
|
|
#define GONextW() ALWAYS_GONextW()
|
|
|
|
#else
|
|
|
|
#define GONext() JMPNext()
|
|
|
|
#define GONextW() JMPNextW()
|
|
|
|
#endif /* USE_PREFETCH */
|
|
|
|
#if YAP_DBG_PREDS
|
|
|
|
#if YAP_JIT
|
|
|
|
|
|
#define Op(Label,Type) \
|
|
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
|
|
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
|
|
print_instruction(PREG, ON_INTERPRETER); \
|
|
START_PREFETCH(Type)
|
|
|
|
#define OpW(Label,Type) \
|
|
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
|
|
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
|
|
print_instruction(PREG, ON_INTERPRETER); \
|
|
START_PREFETCH_W(Type)
|
|
|
|
#define BOp(Label,Type) \
|
|
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
|
|
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
|
|
print_instruction(PREG, ON_INTERPRETER);
|
|
|
|
#define PBOp(Label,Type) \
|
|
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
|
|
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
|
|
print_instruction(PREG, ON_INTERPRETER); \
|
|
INIT_PREFETCH()
|
|
|
|
#define OpRW(Label,Type) \
|
|
_##Label:{ (ExpEnv.config_struc.current_displacement) ? \
|
|
print_instruction(PREG, ON_PROFILED_INTERPRETER) : \
|
|
print_instruction(PREG, ON_INTERPRETER);
|
|
|
|
#else /* YAP_JIT */
|
|
|
|
#define Op(Label,Type) \
|
|
_##Label:{ print_instruction(PREG, ON_INTERPRETER); \
|
|
START_PREFETCH(Type)
|
|
|
|
#define OpW(Label,Type) \
|
|
_##Label:{ print_instruction(PREG, ON_INTERPRETER); \
|
|
START_PREFETCH_W(Type)
|
|
|
|
#define BOp(Label,Type) \
|
|
_##Label:{ print_instruction(PREG, ON_INTERPRETER);
|
|
|
|
#define PBOp(Label,Type) \
|
|
_##Label:{ print_instruction(PREG, ON_INTERPRETER); \
|
|
INIT_PREFETCH()
|
|
|
|
#define OpRW(Label,Type) \
|
|
_##Label:{ print_instruction(PREG, ON_INTERPRETER);
|
|
|
|
#endif /* YAP_JIT */
|
|
|
|
#else /* YAP_DBG_PREDS */
|
|
|
|
#define Op(Label,Type) \
|
|
_##Label:{ START_PREFETCH(Type)
|
|
|
|
#define OpW(Label,Type) \
|
|
_##Label:{ START_PREFETCH_W(Type)
|
|
|
|
#define BOp(Label,Type) \
|
|
_##Label:{
|
|
|
|
#define PBOp(Label,Type) \
|
|
_##Label:{ INIT_PREFETCH()
|
|
|
|
#define OpRW(Label,Type) \
|
|
_##Label:{
|
|
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
#else /* do not use threaded code */
|
|
|
|
#define JMPNext() goto nextop
|
|
|
|
#define JMPNextW() goto nextop_write
|
|
|
|
#define GONext() JMPNext()
|
|
|
|
#define GONextW() JMPNextW()
|
|
|
|
#define ALWAYS_GONext() GONext()
|
|
|
|
#define ALWAYS_GONextW() GONextW()
|
|
|
|
#define Op(Label,Type) case _##Label: { START_PREFETCH(Type)
|
|
|
|
#define OpW(Label,Type) case _##Label: { START_PREFETCH_W(Type)
|
|
|
|
#define BOp(Label,Type) case _##Label: {
|
|
|
|
#define PBOp(Label,Type) case _##Label: { INIT_PREFETCH()
|
|
|
|
#define OpRW(Label,Type) case _##Label: {
|
|
|
|
#endif
|
|
|
|
#define ENDOp() END_PREFETCH() }
|
|
|
|
#define ENDOpW() END_PREFETCH_W() }
|
|
|
|
#define ENDOpRW() }
|
|
|
|
#define ENDBOp() }
|
|
|
|
#define ENDPBOp() END_PREFETCH() }
|
|
|
|
/**********************************************************************
|
|
* *
|
|
* PC manipulation *
|
|
* *
|
|
**********************************************************************/
|
|
|
|
/*
|
|
* How to set up and move a PC in a nice and disciplined way
|
|
*
|
|
*/
|
|
|
|
typedef CELL label;
|
|
|
|
/* move PC */
|
|
|
|
#define ADJ(P,x) (P)+ADJUST(sizeof(x))
|
|
|
|
/*
|
|
* Lookup PredEntry Structure
|
|
*
|
|
*/
|
|
|
|
#define pred_entry(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->StateOfPred))))
|
|
#define pred_entry_from_code(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->CodeOfPred))))
|
|
#define PredFromDefCode(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred))))
|
|
#define PredFromExpandCode(X) ((PredEntry *)(Unsigned(X)-(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))))
|
|
#define PredCode(X) pred_entry(X)->CodeOfPred
|
|
#define PredOpCode(X) pred_entry(X)->OpcodeOfPred
|
|
#define TruePredCode(X) pred_entry(X)->TrueCodeOfPred
|
|
#define PredFunctor(X) pred_entry(X)->FunctorOfPred
|
|
#define PredArity(X) pred_entry(X)->ArityOfPE
|
|
|
|
#define FlagOff(Mask,w) !(Mask&w)
|
|
#define FlagOn(Mask,w) (Mask&w)
|
|
#define ResetFlag(Mask,w) w &= ~Mask
|
|
#define SetFlag(Mask,w) w |= Mask
|
|
|
|
/**********************************************************************
|
|
* *
|
|
* X register access *
|
|
* *
|
|
**********************************************************************/
|
|
|
|
#if PRECOMPUTE_REGADDRESS
|
|
|
|
#define XREG(I) (*(CELL *)(I))
|
|
|
|
#else
|
|
|
|
#define XREG(I) XREGS[I]
|
|
|
|
#endif /* PRECOMPUTE_REGADDRESS */
|
|
|
|
/* The Unification Stack is the Auxiliary stack */
|
|
|
|
#define SP0 ((CELL *)AuxTop)
|
|
#define SP AuxSp
|
|
|
|
/**********************************************************************
|
|
* *
|
|
* RWREG Manipulatio *
|
|
* *
|
|
**********************************************************************/
|
|
|
|
#define READ_MODE 1
|
|
#define WRITE_MODE 0
|
|
|
|
/**********************************************************************
|
|
* *
|
|
*Setting Temporary Copies of Often Used WAM registers for efficiency *
|
|
* *
|
|
**********************************************************************/
|
|
|
|
#ifdef SHADOW_P
|
|
#define NEEDS_TO_SET_PC 1
|
|
#endif
|
|
|
|
/*
|
|
* First, the PC
|
|
*/
|
|
#ifdef NEEDS_TO_SET_PC
|
|
#ifndef _NATIVE
|
|
#define set_pc() PREG = P
|
|
#define save_pc() P = PREG
|
|
#else
|
|
#define set_pc() (*_PREG) = P
|
|
#define save_pc() P = (*_PREG)
|
|
#endif
|
|
#else
|
|
#define set_pc()
|
|
#define save_pc()
|
|
#define PREG (P)
|
|
#endif
|
|
|
|
/*
|
|
* Next, Y
|
|
*/
|
|
#ifdef SHADOW_Y
|
|
#define set_y() YREG = YENV
|
|
#define save_y() YENV = YREG
|
|
#else
|
|
#define set_y()
|
|
#define save_y()
|
|
#define YREG YENV
|
|
#endif
|
|
|
|
/*
|
|
* Next, CP
|
|
*/
|
|
#ifdef SHADOW_CP
|
|
#ifndef _NATIVE
|
|
#define set_cp() CPREG = CP
|
|
#define save_cp() CP = CPREG
|
|
#else
|
|
#define set_cp() (*_CPREG) = CP
|
|
#define save_cp() CP = (*_CPREG)
|
|
#endif
|
|
#else
|
|
#define set_cp()
|
|
#define save_cp()
|
|
#define CPREG CP
|
|
#endif
|
|
|
|
/* Say which registers must be saved at register entry and register
|
|
* exit */
|
|
#define setregs() \
|
|
set_hb(); \
|
|
set_cp(); \
|
|
set_pc(); \
|
|
set_y()
|
|
|
|
#define saveregs() \
|
|
save_hb(); \
|
|
save_cp(); \
|
|
save_pc(); \
|
|
save_y()
|
|
|
|
#if BP_FREE
|
|
/* if we are using BP as a local register, we must save it whenever we leave absmi.c */
|
|
#define always_save_pc() save_pc()
|
|
#define always_set_pc() set_pc()
|
|
#else
|
|
#define always_save_pc()
|
|
#define always_set_pc()
|
|
#endif /* BP_FREE */
|
|
|
|
/************************************************************
|
|
|
|
Macros to check the limits of stacks
|
|
|
|
*************************************************************/
|
|
|
|
#if HAVE_SIGSEGV
|
|
/* for the moment I don't know how to handle trail overflows
|
|
in a pure Windows environment
|
|
*/
|
|
#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(THREADS) && !defined(YAPOR) && !defined(USE_SYSTEM_MALLOC) && !USE_DL_MALLOC
|
|
#define OS_HANDLES_TR_OVERFLOW 1
|
|
#endif
|
|
#endif
|
|
|
|
#ifdef OS_HANDLES_TR_OVERFLOW
|
|
|
|
#define check_trail(x)
|
|
|
|
#define check_trail_in_indexing(x)
|
|
|
|
#else
|
|
|
|
#ifdef _NATIVE
|
|
|
|
#if YAP_DBG_PREDS
|
|
|
|
#define check_trail(x) if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)),0)) { \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.native_treat_trail != 0 && (char*)ExpEnv.debug_struc.pprint_me.native_treat_trail != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.native_treat_trail); \
|
|
} \
|
|
return external_labels[9]; \
|
|
}
|
|
|
|
#else /* YAP_DBG_PREDS */
|
|
|
|
#define check_trail(x) if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)),0)) { \
|
|
return external_labels[9]; \
|
|
}
|
|
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
#define check_trail_in_indexing(x) if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)),0)) \
|
|
goto notrailleft_from_index
|
|
|
|
#else
|
|
|
|
#if YAP_DBG_PREDS
|
|
|
|
#define check_trail(x) if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)),0)) { \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_trail != 0 && (char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_trail != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_trail); \
|
|
} \
|
|
goto notrailleft; \
|
|
}
|
|
|
|
#else /* YAP_DBG_PREDS */
|
|
|
|
#define check_trail(x) if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)),0)) { \
|
|
goto notrailleft; \
|
|
}
|
|
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
#define check_trail_in_indexing(x) if (__builtin_expect((Unsigned(CurrentTrailTop) < Unsigned(x)),0)) \
|
|
goto notrailleft_from_index
|
|
|
|
#endif /* _NATIVE */
|
|
|
|
#endif /* OS_HANDLES_TR_OVERFLOW */
|
|
|
|
#if YAP_DBG_PREDS
|
|
#if (defined(YAPOR_SBA) && defined(YAPOR)) || defined(TABLING)
|
|
#define check_stack(Label, GLOB) \
|
|
if (__builtin_expect( ((Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CreepFlag), 0) ) { \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != 0 && (char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap); \
|
|
} \
|
|
goto Label; \
|
|
}
|
|
#else
|
|
#define check_stack(Label, GLOB) \
|
|
if (__builtin_expect(((Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CreepFlag ), 0) ) { \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != 0 && (char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.interpreted_treat_heap); \
|
|
} \
|
|
goto Label; \
|
|
}
|
|
#endif /* YAPOR_SBA && YAPOR */
|
|
#else /* YAP_DBG_PREDS */
|
|
#if (defined(YAPOR_SBA) && defined(YAPOR)) || defined(TABLING)
|
|
#define check_stack(Label, GLOB) \
|
|
if (__builtin_expect( ((Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CreepFlag), 0) ) { \
|
|
goto Label; \
|
|
}
|
|
#else
|
|
#define check_stack(Label, GLOB) \
|
|
if (__builtin_expect(((Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CreepFlag ), 0) ) { \
|
|
goto Label; \
|
|
}
|
|
#endif /* YAPOR_SBA && YAPOR */
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
/***************************************************************
|
|
* Macros for choice point manipulation *
|
|
***************************************************************/
|
|
|
|
/***************************************************************
|
|
* Store variable number of arguments in a choice point *
|
|
***************************************************************/
|
|
/***
|
|
pt1 points at the new choice point,
|
|
pt0 points at XREGS[i]
|
|
d0 is a counter
|
|
The macro just pushes the arguments one by one to the local stack.
|
|
***/
|
|
#define store_args(arity) \
|
|
BEGP(pt0); \
|
|
pt0 = XREGS+(arity); \
|
|
while ( pt0 > XREGS ) \
|
|
{ register CELL x = pt0[0]; \
|
|
S_YREG = S_YREG-1; \
|
|
--pt0; \
|
|
(S_YREG)[0] = x; \
|
|
} \
|
|
ENDP(pt0)
|
|
|
|
#define store_at_least_one_arg(arity) \
|
|
BEGP(pt0); \
|
|
pt0 = XREGS+(arity); \
|
|
do { CELL x = pt0[0]; \
|
|
S_YREG = (S_YREG)-1; \
|
|
--pt0; \
|
|
(S_YREG)[0] = x; \
|
|
} \
|
|
while ( pt0 > XREGS ); \
|
|
ENDP(pt0)
|
|
|
|
#if LOW_LEVEL_TRACER && 0
|
|
#define COUNT_CPS() LOCAL_total_choicepoints++
|
|
#else
|
|
#define COUNT_CPS()
|
|
#endif
|
|
|
|
/***************************************************************
|
|
* Do the bulk of work in creating a choice-point *
|
|
* AP: alternative pointer *
|
|
***************************************************************/
|
|
/*
|
|
* The macro just sets pt1 to point to the base of the choicepoint
|
|
* and then fills in all the necessary fields
|
|
*/
|
|
#ifdef DEPTH_LIMIT
|
|
#define store_yaam_reg_cpdepth(CPTR) (CPTR)->cp_depth = DEPTH
|
|
#else
|
|
#define store_yaam_reg_cpdepth(CPTR)
|
|
#endif
|
|
|
|
#ifndef _NATIVE
|
|
#define store_yaam_regs(AP,I) \
|
|
{ /* Jump to CP_BASE */ \
|
|
COUNT_CPS(); \
|
|
S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \
|
|
/* Save Information */ \
|
|
HBREG = HR; \
|
|
B_YREG->cp_tr = TR; \
|
|
B_YREG->cp_h = HR; \
|
|
B_YREG->cp_b = B; \
|
|
store_yaam_reg_cpdepth(B_YREG); \
|
|
B_YREG->cp_cp = CPREG; \
|
|
B_YREG->cp_ap = AP; \
|
|
B_YREG->cp_env= ENV; \
|
|
}
|
|
#else /* _NATIVE */
|
|
#define store_yaam_regs(AP,I) \
|
|
{ /* Jump to CP_BASE */ \
|
|
COUNT_CPS(); \
|
|
S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \
|
|
/* Save Information */ \
|
|
HBREG = HR; \
|
|
B_YREG->cp_tr = TR; \
|
|
B_YREG->cp_h = HR; \
|
|
B_YREG->cp_b = B; \
|
|
store_yaam_reg_cpdepth(B_YREG); \
|
|
B_YREG->cp_cp = (*_CPREG); \
|
|
B_YREG->cp_ap = AP; \
|
|
B_YREG->cp_env= ENV; \
|
|
}
|
|
#endif
|
|
|
|
#define store_yaam_regs_for_either(AP,d0) \
|
|
COUNT_CPS(); \
|
|
pt1 --; /* Jump to CP_BASE */ \
|
|
/* Save Information */ \
|
|
HBREG = HR; \
|
|
pt1->cp_tr = TR; \
|
|
pt1->cp_h = HR; \
|
|
pt1->cp_b = B; \
|
|
store_yaam_reg_cpdepth(pt1); \
|
|
pt1->cp_cp = d0; \
|
|
pt1->cp_ap = AP; \
|
|
pt1->cp_env = ENV;
|
|
|
|
/***************************************************************
|
|
* Place B as the new place to cut to *
|
|
***************************************************************/
|
|
#define set_cut(E,B) (E)[E_CB] = (CELL)(B)
|
|
|
|
/***************************************************************
|
|
* Restore WAM registers from a choice point *
|
|
***************************************************************/
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
#define restore_yaam_reg_cpdepth(CPTR) DEPTH = (CPTR)->cp_depth
|
|
#else
|
|
#define restore_yaam_reg_cpdepth(CPTR)
|
|
#endif
|
|
|
|
#ifdef YAPOR
|
|
#define YAPOR_update_alternative(CUR_ALT, NEW_ALT) \
|
|
if (SCH_top_shared_cp(B)) { \
|
|
SCH_new_alternative(CUR_ALT, NEW_ALT); \
|
|
} else
|
|
#else
|
|
#define YAPOR_update_alternative(CUR_ALT, NEW_ALT)
|
|
#endif /* YAPOR */
|
|
|
|
#if defined(FROZEN_STACKS) && !defined(BFZ_TRAIL_SCHEME)
|
|
#define SET_BB(V) BBREG = (V)
|
|
#else
|
|
#define SET_BB(V)
|
|
#endif /* FROZEN_STACKS && !BFZ_TRAIL_SCHEME */
|
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
#ifdef YAPOR_SBA
|
|
#define PROTECT_FROZEN_H(CPTR) \
|
|
((Unsigned((Int)((CPTR)->cp_h)-(Int)(H_FZ)) < \
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ? \
|
|
(CPTR)->cp_h : H_FZ)
|
|
#define PROTECT_FROZEN_B(CPTR) \
|
|
((Unsigned((Int)(CPTR)-(Int)(H_FZ)) < \
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ? \
|
|
(CPTR) : B_FZ)
|
|
/*
|
|
#define PROTECT_FROZEN_H(CPTR) ((CPTR)->cp_h > H_FZ && (CPTR)->cp_h < (CELL *)B_FZ ? (CPTR)->cp_h : H_FZ )
|
|
|
|
#define PROTECT_FROZEN_B(CPTR) ((CPTR) < B_FZ && (CPTR) > (choiceptr)H_FZ ? (CPTR) : B_FZ )
|
|
*/
|
|
#else /* TABLING */
|
|
#define PROTECT_FROZEN_B(CPTR) (YOUNGER_CP(CPTR, B_FZ) ? CPTR : B_FZ)
|
|
#define PROTECT_FROZEN_H(CPTR) (((CPTR)->cp_h > H_FZ) ? (CPTR)->cp_h : H_FZ)
|
|
#endif /* YAPOR_SBA */
|
|
#else
|
|
#define PROTECT_FROZEN_B(CPTR) (CPTR)
|
|
#define PROTECT_FROZEN_H(CPTR) (CPTR)->cp_h
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
#ifndef _NATIVE
|
|
#define restore_yaam_regs(AP) \
|
|
{ register CELL *x1 = B_YREG->cp_env; \
|
|
register yamop *x2; \
|
|
HR = HBREG = PROTECT_FROZEN_H(B_YREG); \
|
|
restore_yaam_reg_cpdepth(B_YREG); \
|
|
CPREG = B_YREG->cp_cp; \
|
|
/* AP may depend on H */ \
|
|
x2 = (yamop *)AP; \
|
|
ENV = x1; \
|
|
YAPOR_update_alternative(PREG, x2) \
|
|
B_YREG->cp_ap = x2; \
|
|
}
|
|
#else
|
|
#define restore_yaam_regs(AP) \
|
|
{ register CELL *x1 = B_YREG->cp_env; \
|
|
register yamop *x2; \
|
|
H = HBREG = PROTECT_FROZEN_H(B_YREG); \
|
|
restore_yaam_reg_cpdepth(B_YREG); \
|
|
(*_CPREG) = B_YREG->cp_cp; \
|
|
/* AP may depend on H */ \
|
|
x2 = (yamop *)AP; \
|
|
ENV = x1; \
|
|
YAPOR_update_alternative((*_PREG), x2) \
|
|
B_YREG->cp_ap = x2; \
|
|
}
|
|
#endif
|
|
|
|
/***************************************************************
|
|
* Restore variable number of arguments from a choice point *
|
|
***************************************************************/
|
|
#define restore_args(Nargs) \
|
|
BEGD(d0); \
|
|
d0 = Nargs; \
|
|
BEGP(pt0); \
|
|
BEGP(pt1); \
|
|
pt1 = (CELL *)(B_YREG+1)+d0; \
|
|
pt0 = XREGS+1+d0; \
|
|
while (pt0 > XREGS +1 ) \
|
|
{ register CELL x = pt1[-1]; \
|
|
--pt0; \
|
|
--pt1; \
|
|
*pt0 = x; \
|
|
} \
|
|
ENDP(pt1); \
|
|
ENDP(pt0); \
|
|
ENDD(d0)
|
|
|
|
#define restore_at_least_one_arg(Nargs) \
|
|
BEGD(d0); \
|
|
d0 = Nargs; \
|
|
BEGP(pt0); \
|
|
BEGP(pt1); \
|
|
pt1 = (CELL *)(B_YREG+1)+d0; \
|
|
pt0 = XREGS+1+d0; \
|
|
do { register CELL x = pt1[-1]; \
|
|
--pt0; \
|
|
--pt1; \
|
|
*pt0 = x; \
|
|
} \
|
|
while (pt0 > XREGS +1 ); \
|
|
ENDP(pt1); \
|
|
ENDP(pt0); \
|
|
ENDD(d0)
|
|
|
|
/***************************************************************
|
|
* Execute trust to release YAAM registers and pop choice point *
|
|
***************************************************************/
|
|
#ifdef DEPTH_LIMIT
|
|
#define pop_yaam_reg_cpdepth(CPTR) DEPTH = (CPTR)->cp_depth
|
|
#else
|
|
#define pop_yaam_reg_cpdepth(CPTR)
|
|
#endif
|
|
|
|
#ifdef TABLING
|
|
#define TABLING_close_alt(CPTR) (CPTR)->cp_ap = NULL
|
|
#else
|
|
#define TABLING_close_alt(CPTR)
|
|
#endif /* TABLING */
|
|
|
|
#ifndef _NATIVE
|
|
#define pop_yaam_regs() \
|
|
{ \
|
|
HR = PROTECT_FROZEN_H(B_YREG); \
|
|
B = B_YREG->cp_b; \
|
|
pop_yaam_reg_cpdepth(B_YREG); \
|
|
CPREG = B_YREG->cp_cp; \
|
|
ENV = B_YREG->cp_env; \
|
|
TABLING_close_alt(B_YREG); \
|
|
HBREG = PROTECT_FROZEN_H(B); \
|
|
}
|
|
#else
|
|
#define pop_yaam_regs() \
|
|
{ \
|
|
HR = PROTECT_FROZEN_H(B_YREG); \
|
|
B = B_YREG->cp_b; \
|
|
pop_yaam_reg_cpdepth(B_YREG); \
|
|
(*_CPREG) = B_YREG->cp_cp; \
|
|
ENV = B_YREG->cp_env; \
|
|
TABLING_close_alt(B_YREG); \
|
|
HBREG = PROTECT_FROZEN_H(B); \
|
|
}
|
|
#endif
|
|
|
|
#define pop_args(NArgs) \
|
|
BEGD(d0); \
|
|
d0 = (NArgs); \
|
|
BEGP(pt0); \
|
|
BEGP(pt1); \
|
|
S_YREG = (CELL *)(B_YREG+1); \
|
|
pt0 = XREGS + 1 ; \
|
|
pt1 = S_YREG ; \
|
|
while (pt0 < XREGS+1+d0) \
|
|
{ register CELL x = pt1[0]; \
|
|
pt1++; \
|
|
pt0++; \
|
|
pt0[-1] = x; \
|
|
} \
|
|
S_YREG = pt1; \
|
|
ENDP(pt1); \
|
|
ENDP(pt0); \
|
|
ENDD(d0);
|
|
|
|
#define pop_at_least_one_arg(NArgs) \
|
|
BEGD(d0); \
|
|
d0 = (NArgs); \
|
|
BEGP(pt0); \
|
|
BEGP(pt1); \
|
|
pt1 = (CELL *)(B_YREG+1); \
|
|
pt0 = XREGS + 1 ; \
|
|
do { register CELL x = pt1[0]; \
|
|
pt1++; \
|
|
pt0++; \
|
|
pt0[-1] = x; \
|
|
} \
|
|
while (pt0 < XREGS+1+d0); \
|
|
S_YREG = pt1; \
|
|
ENDP(pt1); \
|
|
ENDP(pt0); \
|
|
ENDD(d0);
|
|
|
|
/**********************************************************************
|
|
* *
|
|
* failure and backtracking *
|
|
* *
|
|
**********************************************************************/
|
|
|
|
/* Failure can be called from two routines.
|
|
*
|
|
* If from within the emulator, we should jump to the label fail.
|
|
*
|
|
* If from within the complex-term unification routine, we should jump
|
|
* to the label "cufail".
|
|
*
|
|
*/
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#if YAP_DBG_PREDS
|
|
|
|
#define FAIL() { \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.interpreted_backtrack != 0 && (char*)ExpEnv.debug_struc.pprint_me.interpreted_backtrack != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.interpreted_backtrack); \
|
|
} \
|
|
goto fail; \
|
|
}
|
|
|
|
#define TRACED_FAIL() { \
|
|
if ((char*)ExpEnv.debug_struc.pprint_me.profiled_interpreted_backtrack != 0 && (char*)ExpEnv.debug_struc.pprint_me.profiled_interpreted_backtrack != (char*)0x1) { \
|
|
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); \
|
|
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.profiled_interpreted_backtrack); \
|
|
} \
|
|
goto traced_fail; \
|
|
}
|
|
|
|
#else /* YAP_DBG_PREDS */
|
|
|
|
#define FAIL() { \
|
|
goto fail; \
|
|
}
|
|
|
|
#define TRACED_FAIL() { \
|
|
goto traced_fail; \
|
|
}
|
|
|
|
#endif /* YAP_DBG_PREDS */
|
|
|
|
#else
|
|
|
|
#define FAIL() { return external_labels[0]; }
|
|
|
|
#endif
|
|
|
|
/**********************************************************************
|
|
* *
|
|
* unification routines *
|
|
* *
|
|
**********************************************************************/
|
|
|
|
#define UnifyGlobalCells(a, b) \
|
|
if ((b) > (a)) { \
|
|
if (GlobalIsAttVar(b) && !GlobalIsAttVar(a)) { \
|
|
Bind_Global((a),(CELL)(b)); \
|
|
} else { \
|
|
Bind_Global((b),(CELL)(a)); \
|
|
} \
|
|
} else if ((b) < (a)) { \
|
|
if (GlobalIsAttVar(a) && !GlobalIsAttVar(b)) { \
|
|
Bind_Global((b),(CELL)(a)); \
|
|
} else { \
|
|
Bind_Global((a),(CELL)(b)); \
|
|
} \
|
|
}
|
|
|
|
#define UnifyGlobalCellToCell(b, a) \
|
|
if ((a) < HR) { /* two globals */ \
|
|
UnifyGlobalCells(a,b); \
|
|
} else { \
|
|
Bind_Local((a),(CELL)(b)); \
|
|
}
|
|
|
|
#define UnifyCells(a, b) \
|
|
if ((a) < HR) { /* at least one global */ \
|
|
if ((b) > HR) { Bind_Local((b),(CELL)(a)); } \
|
|
else { UnifyGlobalCells(a,b); } \
|
|
} else { \
|
|
if ((b) > (a)) { Bind_Local((a),(CELL)(b)); } \
|
|
else if ((a) > (b)) { \
|
|
if ((b) < HR) { Bind_Local((a),(CELL)(b)); } \
|
|
else { Bind_Local((b),(CELL)(a)); } \
|
|
} \
|
|
}
|
|
|
|
/* unify two complex terms.
|
|
*
|
|
* I use two stacks: one keeps the visited terms, and the other keeps the
|
|
* terms to visit.
|
|
*
|
|
* The terms-to-visit stack is used to implement traditional
|
|
* recursion. The visited-terms-stack is used to link structures already
|
|
* visited and allows unification of infinite terms
|
|
*
|
|
*/
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
#define UNWIND_CUNIF() \
|
|
while (visited < AuxSp) { \
|
|
pt1 = (CELL *)visited[0]; \
|
|
*pt1 = visited[1]; \
|
|
visited += 2; \
|
|
}
|
|
|
|
#else
|
|
#define UNWIND_CUNIF()
|
|
#endif
|
|
|
|
#define UnifyBound_TEST_ATTACHED(f,d0,pt0,d1) \
|
|
if (IsExtensionFunctor(f)) { \
|
|
if (unify_extension(f, d0, RepAppl(d0), d1)) \
|
|
{ GONext(); } \
|
|
else \
|
|
{ FAIL(); } \
|
|
}
|
|
|
|
|
|
#define UnifyBound(d0,d1) \
|
|
if (d0 == d1) { GONext(); } \
|
|
if (IsPairTerm(d0)) { \
|
|
register CELL *ipt0, *ipt1; \
|
|
if (!IsPairTerm(d1)) { FAIL(); } \
|
|
ipt0 = RepPair(d0); \
|
|
ipt1 = RepPair(d1); \
|
|
save_hb(); \
|
|
always_save_pc(); \
|
|
if (IUnify_complex(ipt0-1,ipt0+1,ipt1-1)) {always_set_pc(); GONext();} \
|
|
else { FAIL(); } \
|
|
} else if (IsApplTerm(d0)) { \
|
|
register CELL *ipt0, *ipt1; \
|
|
register Functor f; \
|
|
if (!IsApplTerm(d1)) { FAIL(); } \
|
|
ipt0 = RepAppl(d0); \
|
|
ipt1 = RepAppl(d1); \
|
|
f = (Functor)*ipt0; \
|
|
if (f != (Functor)*ipt1) { FAIL(); } \
|
|
UnifyBound_TEST_ATTACHED(f,d0,ipt0,d1); \
|
|
d0 = ArityOfFunctor(f); \
|
|
always_save_pc(); \
|
|
save_hb(); \
|
|
if (IUnify_complex(ipt0, ipt0+d0, ipt1)) {always_set_pc(); GONext();} \
|
|
else { FAIL(); } \
|
|
} \
|
|
else { FAIL(); }
|
|
|
|
#define traced_UnifyBound_TEST_ATTACHED(f,d0,pt0,d1) \
|
|
if (IsExtensionFunctor(f)) { \
|
|
if (unify_extension(f, d0, RepAppl(d0), d1)) \
|
|
{ GONext(); } \
|
|
else \
|
|
{ TRACED_FAIL(); } \
|
|
}
|
|
|
|
|
|
#define traced_UnifyBound(d0,d1) \
|
|
if (d0 == d1) { GONext(); } \
|
|
if (IsPairTerm(d0)) { \
|
|
register CELL *ipt0, *ipt1; \
|
|
if (!IsPairTerm(d1)) { TRACED_FAIL(); } \
|
|
ipt0 = RepPair(d0); \
|
|
ipt1 = RepPair(d1); \
|
|
save_hb(); \
|
|
always_save_pc(); \
|
|
if (IUnify_complex(ipt0-1,ipt0+1,ipt1-1)) {always_set_pc(); GONext();} \
|
|
else { TRACED_FAIL(); } \
|
|
} else if (IsApplTerm(d0)) { \
|
|
register CELL *ipt0, *ipt1; \
|
|
register Functor f; \
|
|
if (!IsApplTerm(d1)) { TRACED_FAIL(); } \
|
|
ipt0 = RepAppl(d0); \
|
|
ipt1 = RepAppl(d1); \
|
|
f = (Functor)*ipt0; \
|
|
if (f != (Functor)*ipt1) { TRACED_FAIL(); } \
|
|
traced_UnifyBound_TEST_ATTACHED(f,d0,ipt0,d1); \
|
|
d0 = ArityOfFunctor(f); \
|
|
always_save_pc(); \
|
|
save_hb(); \
|
|
if (IUnify_complex(ipt0, ipt0+d0, ipt1)) {always_set_pc(); GONext();} \
|
|
else { TRACED_FAIL(); } \
|
|
} \
|
|
else { TRACED_FAIL(); }
|
|
|
|
|
|
/*
|
|
* Next, HB
|
|
*/
|
|
#ifdef SHADOW_HB
|
|
#undef HBREG
|
|
#define set_hb() HBREG = HB
|
|
#define save_hb() HB = HBREG
|
|
#else
|
|
#define set_hb()
|
|
#define save_hb()
|
|
#endif
|
|
|
|
typedef struct unif_record {
|
|
CELL *ptr;
|
|
Term old;
|
|
} unif_record;
|
|
|
|
typedef struct v_record {
|
|
CELL *start0;
|
|
CELL *end0;
|
|
CELL *start1;
|
|
Term old;
|
|
} v_record;
|
|
|
|
#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)|| defined(IN_TRACED_ABSMI_C)
|
|
|
|
|
|
static int
|
|
IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
|
|
{
|
|
CACHE_REGS
|
|
#ifdef THREADS
|
|
#undef Yap_REGS
|
|
register REGSTORE *regp = Yap_regp;
|
|
#define Yap_REGS (*regp)
|
|
#elif defined(SHADOW_REGS)
|
|
#if defined(B) || defined(TR)
|
|
register REGSTORE *regp = &Yap_REGS;
|
|
|
|
#define Yap_REGS (*regp)
|
|
#endif /* defined(B) || defined(TR) || defined(HB) */
|
|
#endif
|
|
|
|
#ifdef SHADOW_HB
|
|
register CELL *HBREG = HB;
|
|
#endif /* SHADOW_HB */
|
|
|
|
struct unif_record *unif = (struct unif_record *)AuxBase;
|
|
struct v_record *to_visit = (struct v_record *)AuxSp;
|
|
#define unif_base ((struct unif_record *)AuxBase)
|
|
#define to_visit_base ((struct v_record *)AuxSp)
|
|
|
|
loop:
|
|
while (pt0 < pt0_end) {
|
|
register CELL *ptd0 = pt0+1;
|
|
register CELL d0;
|
|
|
|
++pt1;
|
|
pt0 = ptd0;
|
|
d0 = *ptd0;
|
|
deref_head(d0, unify_comp_unk);
|
|
unify_comp_nvar:
|
|
{
|
|
register CELL *ptd1 = pt1;
|
|
register CELL d1 = *ptd1;
|
|
|
|
deref_head(d1, unify_comp_nvar_unk);
|
|
unify_comp_nvar_nvar:
|
|
if (d0 == d1)
|
|
continue;
|
|
if (IsPairTerm(d0)) {
|
|
if (!IsPairTerm(d1)) {
|
|
goto cufail;
|
|
}
|
|
/* now link the two structures so that no one else will */
|
|
/* come here */
|
|
/* store the terms to visit */
|
|
if (RATIONAL_TREES || pt0 < pt0_end) {
|
|
to_visit --;
|
|
#ifdef RATIONAL_TREES
|
|
unif++;
|
|
#endif
|
|
if ((void *)to_visit < (void *)unif) {
|
|
CELL **urec = (CELL **)unif;
|
|
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
|
|
unif = (struct unif_record *)urec;
|
|
}
|
|
to_visit->start0 = pt0;
|
|
to_visit->end0 = pt0_end;
|
|
to_visit->start1 = pt1;
|
|
#ifdef RATIONAL_TREES
|
|
unif[-1].old = *pt0;
|
|
unif[-1].ptr = pt0;
|
|
*pt0 = d1;
|
|
#endif
|
|
}
|
|
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
|
|
pt1 = RepPair(d1) - 1;
|
|
continue;
|
|
}
|
|
if (IsApplTerm(d0)) {
|
|
register Functor f;
|
|
register CELL *ap2, *ap3;
|
|
|
|
if (!IsApplTerm(d1)) {
|
|
goto cufail;
|
|
}
|
|
/* store the terms to visit */
|
|
ap2 = RepAppl(d0);
|
|
ap3 = RepAppl(d1);
|
|
f = (Functor) (*ap2);
|
|
/* compare functors */
|
|
if (f != (Functor) *ap3)
|
|
goto cufail;
|
|
if (IsExtensionFunctor(f)) {
|
|
if (unify_extension(f, d0, ap2, d1))
|
|
continue;
|
|
goto cufail;
|
|
}
|
|
/* now link the two structures so that no one else will */
|
|
/* come here */
|
|
/* store the terms to visit */
|
|
if (RATIONAL_TREES || pt0 < pt0_end) {
|
|
to_visit --;
|
|
#ifdef RATIONAL_TREES
|
|
unif++;
|
|
#endif
|
|
if ((void *)to_visit < (void *)unif) {
|
|
CELL **urec = (CELL **)unif;
|
|
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
|
|
unif = (struct unif_record *)urec;
|
|
}
|
|
to_visit->start0 = pt0;
|
|
to_visit->end0 = pt0_end;
|
|
to_visit->start1 = pt1;
|
|
#ifdef RATIONAL_TREES
|
|
unif[-1].old = *pt0;
|
|
unif[-1].ptr = pt0;
|
|
*pt0 = d1;
|
|
#endif
|
|
}
|
|
d0 = ArityOfFunctor(f);
|
|
pt0 = ap2;
|
|
pt0_end = ap2 + d0;
|
|
pt1 = ap3;
|
|
continue;
|
|
}
|
|
goto cufail;
|
|
|
|
derefa_body(d1, ptd1, unify_comp_nvar_unk, unify_comp_nvar_nvar);
|
|
/* d1 and pt2 have the unbound value, whereas d0 is bound */
|
|
Bind_Global(ptd1, d0);
|
|
continue;
|
|
}
|
|
|
|
derefa_body(d0, ptd0, unify_comp_unk, unify_comp_nvar);
|
|
/* first arg var */
|
|
{
|
|
register CELL d1;
|
|
register CELL *ptd1;
|
|
|
|
ptd1 = pt1;
|
|
d1 = ptd1[0];
|
|
/* pt2 is unbound */
|
|
deref_head(d1, unify_comp_var_unk);
|
|
unify_comp_var_nvar:
|
|
/* pt2 is unbound and d1 is bound */
|
|
Bind_Global(ptd0, d1);
|
|
continue;
|
|
|
|
derefa_body(d1, ptd1, unify_comp_var_unk, unify_comp_var_nvar);
|
|
/* ptd0 and ptd1 are unbound */
|
|
UnifyGlobalCells(ptd0, ptd1);
|
|
}
|
|
}
|
|
/* Do we still have compound terms to visit */
|
|
if (to_visit < to_visit_base) {
|
|
pt0 = to_visit->start0;
|
|
pt0_end = to_visit->end0;
|
|
pt1 = to_visit->start1;
|
|
to_visit++;
|
|
goto loop;
|
|
}
|
|
#ifdef RATIONAL_TREES
|
|
/* restore bindigs */
|
|
while (unif-- != unif_base) {
|
|
CELL *pt0;
|
|
|
|
pt0 = unif->ptr;
|
|
*pt0 = unif->old;
|
|
}
|
|
#endif
|
|
return TRUE;
|
|
|
|
cufail:
|
|
#ifdef RATIONAL_TREES
|
|
/* restore bindigs */
|
|
while (unif-- != unif_base) {
|
|
CELL *pt0;
|
|
|
|
pt0 = unif->ptr;
|
|
*pt0 = unif->old;
|
|
}
|
|
#endif
|
|
return FALSE;
|
|
#ifdef THREADS
|
|
#undef Yap_REGS
|
|
#define Yap_REGS (*Yap_regp)
|
|
#elif defined(SHADOW_REGS)
|
|
#if defined(B) || defined(TR)
|
|
#undef Yap_REGS
|
|
#endif /* defined(B) || defined(TR) */
|
|
#endif
|
|
}
|
|
|
|
/* don't pollute name space */
|
|
#undef to_visit_base
|
|
#undef unif_base
|
|
|
|
|
|
#endif
|
|
|
|
|
|
#if defined(IN_ABSMI_C) || defined(IN_INLINES_C) || defined(IN_TRACED_ABSMI_C)
|
|
|
|
static int
|
|
iequ_complex(register CELL *pt0, register CELL *pt0_end,
|
|
register CELL *pt1
|
|
)
|
|
{
|
|
CACHE_REGS
|
|
#ifdef THREADS
|
|
#undef Yap_REGS
|
|
register REGSTORE *regp = Yap_regp;
|
|
#define Yap_REGS (*regp)
|
|
#elif defined(SHADOW_REGS)
|
|
#if defined(B) || defined(TR)
|
|
register REGSTORE *regp = &Yap_REGS;
|
|
|
|
#define Yap_REGS (*regp)
|
|
#endif /* defined(B) || defined(TR) || defined(HB) */
|
|
#endif
|
|
|
|
#ifdef SHADOW_HB
|
|
register CELL *HBREG = HB;
|
|
#endif /* SHADOW_HB */
|
|
|
|
struct unif_record *unif = (struct unif_record *)AuxBase;
|
|
struct v_record *to_visit = (struct v_record *)AuxSp;
|
|
#define unif_base ((struct unif_record *)AuxBase)
|
|
#define to_visit_base ((struct v_record *)AuxSp)
|
|
|
|
loop:
|
|
while (pt0 < pt0_end) {
|
|
register CELL *ptd0 = pt0+1;
|
|
register CELL d0;
|
|
|
|
++pt1;
|
|
pt0 = ptd0;
|
|
d0 = *ptd0;
|
|
deref_head(d0, iequ_comp_unk);
|
|
iequ_comp_nvar:
|
|
{
|
|
register CELL *ptd1 = pt1;
|
|
register CELL d1 = *ptd1;
|
|
|
|
deref_head(d1, iequ_comp_nvar_unk);
|
|
iequ_comp_nvar_nvar:
|
|
if (d0 == d1)
|
|
continue;
|
|
if (IsPairTerm(d0)) {
|
|
if (!IsPairTerm(d1)) {
|
|
goto cufail;
|
|
}
|
|
/* now link the two structures so that no one else will */
|
|
/* come here */
|
|
/* store the terms to visit */
|
|
if (RATIONAL_TREES || pt0 < pt0_end) {
|
|
to_visit --;
|
|
#ifdef RATIONAL_TREES
|
|
unif++;
|
|
#endif
|
|
if ((void *)to_visit < (void *)unif) {
|
|
CELL **urec = (CELL **)unif;
|
|
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
|
|
unif = (struct unif_record *)urec;
|
|
}
|
|
to_visit->start0 = pt0;
|
|
to_visit->end0 = pt0_end;
|
|
to_visit->start1 = pt1;
|
|
#ifdef RATIONAL_TREES
|
|
unif[-1].old = *pt0;
|
|
unif[-1].ptr = pt0;
|
|
*pt0 = d1;
|
|
#endif
|
|
}
|
|
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
|
|
pt1 = RepPair(d1) - 1;
|
|
continue;
|
|
}
|
|
if (IsApplTerm(d0)) {
|
|
register Functor f;
|
|
register CELL *ap2, *ap3;
|
|
|
|
if (!IsApplTerm(d1)) {
|
|
goto cufail;
|
|
}
|
|
/* store the terms to visit */
|
|
ap2 = RepAppl(d0);
|
|
ap3 = RepAppl(d1);
|
|
f = (Functor) (*ap2);
|
|
/* compare functors */
|
|
if (f != (Functor) *ap3)
|
|
goto cufail;
|
|
if (IsExtensionFunctor(f)) {
|
|
if (unify_extension(f, d0, ap2, d1))
|
|
continue;
|
|
goto cufail;
|
|
}
|
|
/* now link the two structures so that no one else will */
|
|
/* come here */
|
|
/* store the terms to visit */
|
|
if (RATIONAL_TREES || pt0 < pt0_end) {
|
|
to_visit --;
|
|
#ifdef RATIONAL_TREES
|
|
unif++;
|
|
#endif
|
|
if ((void *)to_visit < (void *)unif) {
|
|
CELL **urec = (CELL **)unif;
|
|
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
|
|
unif = (struct unif_record *)urec;
|
|
}
|
|
to_visit->start0 = pt0;
|
|
to_visit->end0 = pt0_end;
|
|
to_visit->start1 = pt1;
|
|
#ifdef RATIONAL_TREES
|
|
unif[-1].old = *pt0;
|
|
unif[-1].ptr = pt0;
|
|
*pt0 = d1;
|
|
#endif
|
|
}
|
|
d0 = ArityOfFunctor(f);
|
|
pt0 = ap2;
|
|
pt0_end = ap2 + d0;
|
|
pt1 = ap3;
|
|
continue;
|
|
}
|
|
goto cufail;
|
|
|
|
derefa_body(d1, ptd1, iequ_comp_nvar_unk, iequ_comp_nvar_nvar);
|
|
/* d1 and pt2 have the unbound value, whereas d0 is bound */
|
|
goto cufail;
|
|
|
|
}
|
|
|
|
derefa_body(d0, ptd0, iequ_comp_unk, iequ_comp_nvar);
|
|
/* first arg var */
|
|
{
|
|
register CELL d1;
|
|
register CELL *ptd1;
|
|
|
|
ptd1 = pt1;
|
|
d1 = ptd1[0];
|
|
/* pt2 is unbound */
|
|
deref_head(d1, iequ_comp_var_unk);
|
|
iequ_comp_var_nvar:
|
|
/* pt2 is unbound and d1 is bound */
|
|
goto cufail;
|
|
|
|
derefa_body(d1, ptd1, iequ_comp_var_unk, iequ_comp_var_nvar);
|
|
/* pt2 and pt3 are unbound */
|
|
if (ptd0 == ptd1)
|
|
continue;
|
|
goto cufail;
|
|
|
|
}
|
|
}
|
|
/* Do we still have compound terms to visit */
|
|
if (to_visit < to_visit_base) {
|
|
pt0 = to_visit->start0;
|
|
pt0_end = to_visit->end0;
|
|
pt1 = to_visit->start1;
|
|
to_visit++;
|
|
goto loop;
|
|
}
|
|
#ifdef RATIONAL_TREES
|
|
/* restore bindigs */
|
|
while (unif-- != unif_base) {
|
|
CELL *pt0;
|
|
|
|
pt0 = unif->ptr;
|
|
*pt0 = unif->old;
|
|
}
|
|
#endif
|
|
return TRUE;
|
|
|
|
cufail:
|
|
#ifdef RATIONAL_TREES
|
|
/* restore bindigs */
|
|
while (unif-- != unif_base) {
|
|
CELL *pt0;
|
|
|
|
pt0 = unif->ptr;
|
|
*pt0 = unif->old;
|
|
}
|
|
#endif
|
|
return FALSE;
|
|
#ifdef THREADS
|
|
#undef Yap_REGS
|
|
#define Yap_REGS (*Yap_regp)
|
|
#elif defined(SHADOW_REGS)
|
|
#if defined(B) || defined(TR)
|
|
#undef Yap_REGS
|
|
#endif /* defined(B) || defined(TR) */
|
|
#endif
|
|
}
|
|
|
|
#endif
|
|
|
|
static inline wamreg
|
|
Yap_regnotoreg(UInt regnbr)
|
|
{
|
|
#if PRECOMPUTE_REGADDRESS
|
|
return (wamreg)(XREGS + regnbr);
|
|
#else
|
|
#if MSHIFTOFFS
|
|
return regnbr;
|
|
#else
|
|
return CELLSIZE*regnbr;
|
|
#endif
|
|
#endif /* ALIGN_LONGS */
|
|
}
|
|
|
|
static inline UInt
|
|
Yap_regtoregno(wamreg reg)
|
|
{
|
|
#if PRECOMPUTE_REGADDRESS
|
|
return ((CELL *)reg)-XREGS;
|
|
#else
|
|
#if MSHIFTOFFS
|
|
return reg;
|
|
#else
|
|
return reg/CELLSIZE;
|
|
#endif
|
|
#endif /* ALIGN_LONGS */
|
|
}
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
#define check_depth(DEPTH, ap) \
|
|
if ((DEPTH) <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ \
|
|
if ((ap)->ModuleOfPred) { \
|
|
if ((DEPTH) == MkIntTerm(0)) \
|
|
{ FAIL(); } \
|
|
else (DEPTH) = RESET_DEPTH(); \
|
|
} \
|
|
} else if ((ap)->ModuleOfPred) \
|
|
(DEPTH) -= MkIntConstant(2);
|
|
#else
|
|
#define check_depth(DEPTH, ap)
|
|
#endif
|
|
|
|
#if defined(THREADS) || defined(YAPOR)
|
|
#define copy_jmp_address(X) (PREG_ADDR = &(X))
|
|
#define copy_jmp_addressa(X) (PREG_ADDR = (yamop **)(X))
|
|
#else
|
|
#define copy_jmp_address(X)
|
|
#define copy_jmp_addressa(X)
|
|
#endif
|
|
|
|
static inline void
|
|
prune(choiceptr cp USES_REGS)
|
|
{
|
|
#ifdef YAPOR
|
|
CUT_prune_to(cp);
|
|
#endif /* YAPOR */
|
|
if (SHOULD_CUT_UP_TO(B,cp))
|
|
{
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
|
while (B->cp_b < cp) {
|
|
if (POP_CHOICE_POINT(B->cp_b))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
B = B->cp_b;
|
|
}
|
|
if (POP_CHOICE_POINT(B->cp_b))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
/* cut ! */
|
|
#ifdef TABLING
|
|
abolish_incomplete_subgoals(B);
|
|
#endif /* TABLING */
|
|
HB = PROTECT_FROZEN_H(B->cp_b);
|
|
#include "trim_trail.h"
|
|
B = B->cp_b;
|
|
SET_BB(PROTECT_FROZEN_B(B));
|
|
}
|
|
}
|
|
|
|
#if YAPOR
|
|
#define INITIALIZE_PERMVAR(PTR, V) Bind_Local((PTR), (V))
|
|
#else
|
|
#define INITIALIZE_PERMVAR(PTR, V) *(PTR) = (V)
|
|
#endif
|
|
|
|
/* l1: bind a, l2 bind b, l3 no binding */
|
|
#define UnifyAndTrailCells(a, b) \
|
|
if((a) > (b)) { \
|
|
if ((a) < HR) { *(a) = (CELL)(b); DO_TRAIL((a),(CELL)(b)); } \
|
|
else if ((b) <= HR) { *(a) =(CELL)(b); DO_TRAIL((a),(CELL)(b));} \
|
|
else { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \
|
|
} else if((a) < (b)){ \
|
|
if ((b) <= HR) { *(b) = (CELL)(a); DO_TRAIL((b),(CELL)(a)); } \
|
|
else if ((a) <= HR) { *(b) = (CELL) (a); DO_TRAIL((b),(CELL)(a));} \
|
|
else { *(a) = (CELL) (b); DO_TRAIL((a),(CELL)(b));} \
|
|
}
|
|
|
|
|
|
#define CHECK_ALARM(CONT)
|
|
|
|
#if HAVE_SYS_TIME_H
|
|
#include <sys/time.h>
|
|
#endif
|
|
#if HAVE_SYS_RESOURCE_H
|
|
#include <sys/resource.h>
|
|
#endif
|
|
|
|
|
|
#if YAP_JIT
|
|
|
|
extern Environment ExpEnv;
|
|
extern char fin[1024];
|
|
|
|
#ifndef _NATIVE
|
|
|
|
#include <math.h>
|
|
|
|
#ifndef __cplusplus
|
|
#include "JIT_Compiler.hpp"
|
|
|
|
void* (*Yap_JitCall)(JIT_Compiler* jc, yamop* p);
|
|
void (* Yap_llvmShutdown)(void ) ;
|
|
Int (* Yap_traced_absmi)(void ) ;
|
|
extern JIT_Compiler *J;
|
|
#endif
|
|
|
|
extern NativeContext *NativeArea;
|
|
extern IntermediatecodeContext *IntermediatecodeArea;
|
|
|
|
extern CELL l;
|
|
extern short global;
|
|
extern CELL nnexec;
|
|
extern yamop* HEADPREG;
|
|
extern CELL BLOCK;
|
|
extern CELL BLOCKADDRESS;
|
|
extern CELL FAILED;
|
|
|
|
extern TraceContext **curtrace;
|
|
extern yamop *curpreg;
|
|
extern BlocksContext **globalcurblock;
|
|
extern COUNT ineedredefinedest;
|
|
extern yamop* headoftrace;
|
|
|
|
|
|
#endif /* _NATIVE */
|
|
#endif /* YAP_JIT */
|
|
|
|
#ifdef SHADOW_S
|
|
#define PROCESS_INT( F, C ) \
|
|
BEGD(d0); \
|
|
Yap_REGS.S_ = SREG; \
|
|
saveregs(); \
|
|
d0 = F ( PASS_REGS1 ); \
|
|
setregs(); \
|
|
SREG = Yap_REGS.S_; \
|
|
if (!d0) FAIL(); \
|
|
PP = NULL; \
|
|
if (d0 == 2) goto C; \
|
|
JMPNext(); \
|
|
ENDD(d0);
|
|
#else
|
|
#define PROCESS_INT( F, C ) \
|
|
BEGD(d0); \
|
|
saveregs(); \
|
|
d0 = F ( PASS_REGS1 ); \
|
|
setregs(); \
|
|
PP = NULL; \
|
|
if (!d0) FAIL(); \
|
|
if (d0 == 2) goto C; \
|
|
JMPNext(); \
|
|
ENDD(d0);
|
|
#endif
|
|
|
|
#endif // ABSMI_H
|