From d6364505124f8a7652b7d9c80836ca50d636596d Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 29 Aug 2008 17:27:11 +0100 Subject: [PATCH] more fixes to make rclause.h automatic: define new type n for Integers, as they were mistaken for Term. define early return cases and ifdef exceptions. --- C/absmi.c | 180 ++--- C/agc.c | 10 +- C/amasm.c | 16 +- C/cdmgr.c | 40 +- C/index.c | 20 +- C/tracer.c | 3 +- H/YapOpcodes.h | 32 +- H/amidefs.h | 7 +- H/rclause.h | 1796 +++++++++++++++++++----------------------------- H/rheap.h | 117 ++++ H/sshift.h | 44 +- misc/buildops | 27 +- 12 files changed, 1069 insertions(+), 1223 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index f16a13993..b0f837f44 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -1523,7 +1523,7 @@ Yap_absmi(int inp) /* only meaningful with THREADS on! */ /* lock logical updates predicate. */ - Op(lock_lu, e); + Op(lock_lu, p); #if defined(YAPOR) || defined(THREADS) if (PP) { GONext(); @@ -9569,14 +9569,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_plus_vc, xxc); + Op(p_plus_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, plus_vc_unk); plus_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = MkIntegerTerm(IntOfTerm(d0) + d1); } @@ -9588,8 +9588,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -9739,14 +9739,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_minus_cv, xxc); + Op(p_minus_cv, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, minus_cv_unk); minus_cv_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = MkIntegerTerm(d1 - IntOfTerm(d0)); } @@ -9758,8 +9758,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -9909,14 +9909,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_times_vc, xxc); + Op(p_times_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, times_vc_unk); times_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = times_int(IntOfTerm(d0), d1); } @@ -9928,8 +9928,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10086,14 +10086,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_div_vc, xxc); + Op(p_div_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, div_vc_unk); div_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = MkIntTerm(IntOfTerm(d0) / d1); } @@ -10105,8 +10105,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10119,14 +10119,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_div_cv, xxc); + Op(p_div_cv, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, div_cv_unk); div_cv_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { Int div = IntOfTerm(d0); if (div == 0){ @@ -10144,8 +10144,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10350,14 +10350,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_and_vc, xxc); + Op(p_and_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, and_vc_unk); and_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = MkIntegerTerm(IntOfTerm(d0) & d1); } @@ -10369,8 +10369,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10521,14 +10521,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_or_vc, xxc); + Op(p_or_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, or_vc_unk); or_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = MkIntegerTerm(IntOfTerm(d0) | d1); } @@ -10539,8 +10539,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10694,14 +10694,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_sll_vc, xxc); + Op(p_sll_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, sll_vc_unk); sll_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = do_sll(IntOfTerm(d0), (Int)d1); } @@ -10713,8 +10713,8 @@ Yap_absmi(int inp) } if (PREG == (yamop *)FAILCODE) FAIL(); - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10727,14 +10727,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_sll_cv, xxc); + Op(p_sll_cv, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, sll_cv_unk); sll_cv_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { Int i2 = IntOfTerm(d0); if (i2 < 0) @@ -10750,8 +10750,8 @@ Yap_absmi(int inp) } if (PREG == (yamop *)FAILCODE) FAIL(); - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10954,14 +10954,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_slr_vc, xxc); + Op(p_slr_vc, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, slr_vc_unk); slr_vc_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { d0 = MkIntTerm(IntOfTerm(d0) >> d1); } @@ -10973,8 +10973,8 @@ Yap_absmi(int inp) FAIL(); } } - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -10987,14 +10987,14 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_slr_cv, xxc); + Op(p_slr_cv, xxn); BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); /* first check pt1 */ deref_head(d0, slr_cv_unk); slr_cv_nvar: { - Int d1 = PREG->u.xxc.c; + Int d1 = PREG->u.xxn.c; if (IsIntTerm(d0)) { Int i2 = IntOfTerm(d0); if (i2 < 0) @@ -11010,8 +11010,8 @@ Yap_absmi(int inp) } if (PREG == (yamop *)FAILCODE) FAIL(); - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(PREG, xxn); GONext(); BEGP(pt0); @@ -11839,23 +11839,23 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_arg_cv, xxc); + Op(p_arg_cv, xxn); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { CELL *Ho = H; - Term t = MkIntegerTerm(PREG->u.xxc.c); + Term t = MkIntegerTerm(PREG->u.xxn.c); H[0] = t; - H[1] = XREG(PREG->u.xxc.xi); + H[1] = XREG(PREG->u.xxn.xi); RESET_VARIABLE(H+2); low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("arg"),3),0)),H); H = Ho; } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); - d0 = PREG->u.xxc.c; + d0 = PREG->u.xxn.c; /* d0 now got the argument we want */ BEGD(d1); - d1 = XREG(PREG->u.xxc.xi); + d1 = XREG(PREG->u.xxn.xi); deref_head(d1, arg_arg2_vc_unk); arg_arg2_vc_nvar: /* d1 now got the structure we want to fetch the argument @@ -11879,8 +11879,8 @@ Yap_absmi(int inp) */ FAIL(); } - XREG(PREG->u.xxc.x) = pt0[d0]; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = pt0[d0]; + PREG = NEXTOP(PREG, xxn); GONext(); ENDP(pt0); } @@ -11896,8 +11896,8 @@ Yap_absmi(int inp) } FAIL(); } - XREG(PREG->u.xxc.x) = pt0[d0-1]; - PREG = NEXTOP(PREG, xxc); + XREG(PREG->u.xxn.x) = pt0[d0-1]; + PREG = NEXTOP(PREG, xxn); GONext(); ENDP(pt0); } @@ -12033,7 +12033,7 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_arg_y_cv, xxc); + Op(p_arg_y_cv, yxc); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { CELL *Ho = H; @@ -12250,23 +12250,23 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_func2s_cv, xxc); + Op(p_func2s_cv, xxn); /* A1 is a variable */ restart_func2s_cv: #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { RESET_VARIABLE(H); - H[1] = PREG->u.xxc.c; - H[2] = XREG(PREG->u.xxc.xi); + H[1] = PREG->u.xxn.c; + H[2] = XREG(PREG->u.xxn.xi); low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("functor"),3),0)),H); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); /* We have to build the structure */ - d0 = PREG->u.xxc.c; + d0 = PREG->u.xxn.c; /* we do, let's get the third argument */ BEGD(d1); - d1 = XREG(PREG->u.xxc.xi); + d1 = XREG(PREG->u.xxn.xi); deref_head(d1, func2s_unk2_cv); func2s_nvar2_cv: /* Uuuff, the second and third argument are bound */ @@ -12287,8 +12287,8 @@ Yap_absmi(int inp) H += 2; /* else if arity is 0 just pass d0 through */ /* Ding, ding, we made it */ - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sbpp),l); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),sbpp),l); GONext(); } else if ((Int)d1 > 0) { /* now let's build a compound term */ @@ -12310,7 +12310,7 @@ Yap_absmi(int inp) if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) { /* make sure we have something to show for our trouble */ saveregs(); - if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxc),sbpp))) { + if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxn),sbpp))) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); setregs(); JMPNext(); @@ -12328,12 +12328,12 @@ Yap_absmi(int inp) ENDP(pt1); /* else if arity is 0 just pass d0 through */ /* Ding, ding, we made it */ - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sbpp),l); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),sbpp),l); GONext(); } else if (d1 == 0) { - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sbpp),l); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),sbpp),l); GONext(); } else { saveregs(); @@ -12354,7 +12354,7 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); - Op(p_func2s_vc, xxc); + Op(p_func2s_vc, xxn); /* A1 is a variable */ restart_func2s_vc: #ifdef LOW_LEVEL_TRACER @@ -12362,9 +12362,9 @@ Yap_absmi(int inp) Term ti; CELL *hi = H; - ti = MkIntegerTerm((Int)(PREG->u.xxc.c)); + ti = MkIntegerTerm((Int)(PREG->u.xxn.c)); RESET_VARIABLE(H); - H[1] = XREG(PREG->u.xxc.xi); + H[1] = XREG(PREG->u.xxn.xi); H[2] = ti; low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("functor"),3),0)),H); H = hi; @@ -12372,11 +12372,11 @@ Yap_absmi(int inp) #endif /* LOW_LEVEL_TRACE */ /* We have to build the structure */ BEGD(d0); - d0 = XREG(PREG->u.xxc.xi); + d0 = XREG(PREG->u.xxn.xi); deref_head(d0, func2s_unk_vc); func2s_nvar_vc: BEGD(d1); - d1 = PREG->u.xxc.c; + d1 = PREG->u.xxn.c; if (!IsAtomicTerm(d0)) { saveregs(); Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3"); @@ -12392,14 +12392,14 @@ Yap_absmi(int inp) H += 2; /* else if arity is 0 just pass d0 through */ /* Ding, ding, we made it */ - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sbpp),l); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),sbpp),l); GONext(); } /* now let's build a compound term */ if (d1 == 0) { - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sbpp),l); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),sbpp),l); GONext(); } if (!IsAtomTerm(d0)) { @@ -12420,7 +12420,7 @@ Yap_absmi(int inp) if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) { /* make sure we have something to show for our trouble */ saveregs(); - if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxc),sbpp))) { + if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxn),sbpp))) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); setregs(); JMPNext(); @@ -12439,8 +12439,8 @@ Yap_absmi(int inp) ENDD(d1); /* else if arity is 0 just pass d0 through */ /* Ding, ding, we made it */ - XREG(PREG->u.xxc.x) = d0; - PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sbpp),l); + XREG(PREG->u.xxn.x) = d0; + PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),sbpp),l); GONext(); BEGP(pt1); diff --git a/C/agc.c b/C/agc.c index a1c636ddb..7763ad468 100644 --- a/C/agc.c +++ b/C/agc.c @@ -115,9 +115,17 @@ AtomAdjust(Atom a) #define CharP(X) ((char *)(X)) +#define IntegerAdjust(D) (D) #define AddrAdjust(P) (P) -#define CodeVarAdjust(P) (P) #define MFileAdjust(P) (P) +#define CodeVarAdjust(P) (P) +#define ConstantAdjust(P) (P) +#define ArityAdjust(P) (P) +#define DoubleInCodeAdjust(P) +#define IntegerInCodeAdjust(P) +#define OpcodeAdjust(P) (P) +#define ModuleAdjust(P) (P) +#define ExternalFunctionAdjust(P) (P) #define PredEntryAdjust(P) (P) #define AtomEntryAdjust(P) (P) #define GlobalEntryAdjust(P) (P) diff --git a/C/amasm.c b/C/amasm.c index 3dc6e6aad..0683e85b5 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -2642,11 +2642,11 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed code_p->opc = emit_op(_p_func2s_cv); break; } - code_p->u.xxc.x = emit_x(ve->NoOfVE & MaskVarAdrs); - code_p->u.xxc.c = cmp_info->c_arg; - code_p->u.xxc.xi = cmp_info->x1_arg; + code_p->u.xxn.x = emit_x(ve->NoOfVE & MaskVarAdrs); + code_p->u.xxn.c = cmp_info->c_arg; + code_p->u.xxn.xi = cmp_info->x1_arg; } - GONEXT(xxc); + GONEXT(xxn); break; case TYPE_XC: if (pass_no) { @@ -2696,11 +2696,11 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed code_p->opc = emit_op(_p_func2s_vc); break; } - code_p->u.xxc.x = emit_x(ve->NoOfVE & MaskVarAdrs); - code_p->u.xxc.c = cmp_info->c_arg; - code_p->u.xxc.xi = cmp_info->x1_arg; + code_p->u.xxn.x = emit_x(ve->NoOfVE & MaskVarAdrs); + code_p->u.xxn.c = cmp_info->c_arg; + code_p->u.xxn.xi = cmp_info->x1_arg; } - GONEXT(xxc); + GONEXT(xxn); break; } } diff --git a/C/cdmgr.c b/C/cdmgr.c index e9a2f9b00..15025348f 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -708,6 +708,9 @@ get_pred(Term t, Term tmod, char *pname) ******************************************************************/ +#define DoubleInCodeAdjust(D) +#define IntegerInCodeAdjust(D) +#define IntegerAdjust(D) (D) #define PtoPredAdjust(X) (X) #define PtoOpAdjust(X) (X) #define PtoLUClauseAdjust(P) (P) @@ -719,6 +722,12 @@ get_pred(Term t, Term tmod, char *pname) #define FuncAdjust(X) (X) #define CodeAddrAdjust(X) (X) #define CodeComposedTermAdjust(X) (X) +#define ConstantAdjust(X) (X) +#define ArityAdjust(X) (X) +#define OpcodeAdjust(X) (X) +#define ModuleAdjust(X) (X) +#define ExternalFunctionAdjust(X) (X) +#define AdjustSwitchTable(X,Y,Z) #define rehash(A,B,C) static Term BlobTermAdjust(Term t) { @@ -729,6 +738,23 @@ static Term BlobTermAdjust(Term t) #endif } +static Term ConstantTermAdjust (Term); + +static Term +ConstantTermAdjust (Term t) +{ + if (IsAtomTerm(t)) + return AtomTermAdjust(t); + else if (IsIntTerm(t)) + return t; + else if (IsApplTerm(t)) + return BlobTermAdjust(t); + else if (IsPairTerm(t)) + return CodeComposedTermAdjust(t); + else return t; +} + + #include "rclause.h" #ifdef DEBUG @@ -3180,7 +3206,7 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything) only for retracts */ while (env_ptr && b_ptr > (choiceptr)env_ptr) { - PredEntry *pe = EnvPreg(env_ptr[E_CP]); + PredEntry *pe = EnvPreg((yamop *)env_ptr[E_CP]); if (p == pe) return(TRUE); if (env_ptr != NULL) env_ptr = (CELL *)(env_ptr[E_E]); @@ -3257,7 +3283,7 @@ do_toggle_static_predicates_in_use(int mask) PredEntry *pe; /* check first environments that are younger than our latest choicepoint */ while (b_ptr > (choiceptr)env_ptr) { - PredEntry *pe = EnvPreg(env_ptr[E_CP]); + PredEntry *pe = EnvPreg((yamop *)env_ptr[E_CP]); mark_pred(mask, pe); env_ptr = (CELL *)(env_ptr[E_E]); @@ -4305,7 +4331,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { clause_code = TRUE; pc = NEXTOP(pc,xxx); break; - /* instructions type xxc */ + /* instructions type xxn */ case _p_plus_vc: case _p_minus_cv: case _p_times_vc: @@ -4316,18 +4342,18 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { case _p_slr_vc: case _p_func2s_vc: clause_code = TRUE; - pc = NEXTOP(pc,xxc); + pc = NEXTOP(pc,xxn); break; case _p_div_vc: case _p_sll_cv: case _p_slr_cv: case _p_arg_cv: clause_code = TRUE; - pc = NEXTOP(pc,xxc); + pc = NEXTOP(pc,xxn); break; case _p_func2s_cv: clause_code = TRUE; - pc = NEXTOP(pc,xxc); + pc = NEXTOP(pc,xxn); break; /* instructions type xxy */ case _p_func2f_xy: @@ -5868,7 +5894,7 @@ p_predicate_lu_cps(void) static Int p_program_continuation(void) { - PredEntry *pe = EnvPreg(((CELL *)ENV[E_E])[E_CP]); + PredEntry *pe = EnvPreg((yamop *)((ENV_Parent(ENV))[E_CP])); if (pe->ModuleOfPred) { if (!Yap_unify(ARG1,pe->ModuleOfPred)) return FALSE; diff --git a/C/index.c b/C/index.c index 0c4711506..823c3e04e 100644 --- a/C/index.c +++ b/C/index.c @@ -1373,7 +1373,7 @@ has_cut(yamop *pc) case _p_func2f_xx: pc = NEXTOP(pc,xxx); break; - /* instructions type xxc */ + /* instructions type xxn */ case _p_plus_vc: case _p_minus_cv: case _p_times_vc: @@ -1383,16 +1383,16 @@ has_cut(yamop *pc) case _p_sll_vc: case _p_slr_vc: case _p_func2s_vc: - pc = NEXTOP(pc,xxc); + pc = NEXTOP(pc,xxn); break; case _p_div_vc: case _p_sll_cv: case _p_slr_cv: case _p_arg_cv: - pc = NEXTOP(pc,xxc); + pc = NEXTOP(pc,xxn); break; case _p_func2s_cv: - pc = NEXTOP(pc,xxc); + pc = NEXTOP(pc,xxn); break; /* instructions type xxy */ case _p_func2f_xy: @@ -2321,26 +2321,26 @@ add_info(ClauseDef *clause, UInt regno) case _p_sll_vc: case _p_slr_vc: case _p_func2s_vc: - if (regcopy_in(myregs, nofregs, cl->u.xxc.x) && - (nofregs = delete_regcopy(myregs, nofregs, cl->u.xxc.x)) == 0 && + if (regcopy_in(myregs, nofregs, cl->u.xxn.x) && + (nofregs = delete_regcopy(myregs, nofregs, cl->u.xxn.x)) == 0 && !ycopy) { clause->Tag = (CELL)NULL; return; } - cl = NEXTOP(cl,xxc); + cl = NEXTOP(cl,xxn); break; case _p_div_vc: case _p_sll_cv: case _p_slr_cv: case _p_arg_cv: case _p_func2s_cv: - if (regcopy_in(myregs, nofregs, cl->u.xxc.x) && - (nofregs = delete_regcopy(myregs, nofregs, cl->u.xxc.x)) == 0 && + if (regcopy_in(myregs, nofregs, cl->u.xxn.x) && + (nofregs = delete_regcopy(myregs, nofregs, cl->u.xxn.x)) == 0 && !ycopy) { clause->Tag = (CELL)NULL; return; } - cl = NEXTOP(cl,xxc); + cl = NEXTOP(cl,xxn); break; case _p_func2f_xy: if (regcopy_in(myregs, nofregs, cl->u.xxy.x) && diff --git a/C/tracer.c b/C/tracer.c index 10614109b..f07e73e89 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -164,7 +164,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; - return; + if (vsc_count < 82500) + return; #ifdef THREADS Yap_heap_regs->thread_handle[worker_id].thread_inst_count++; #endif diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index a79016240..2cd268219 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -21,7 +21,7 @@ OPCODE(count_trust_me ,apl), OPCODE(count_retry_logical ,aLl), OPCODE(count_trust_logical ,ILl), - OPCODE(lock_lu ,e), + OPCODE(lock_lu ,p), OPCODE(unlock_lu ,e), OPCODE(alloc_for_logical_pred ,L), OPCODE(copy_idb_term ,e), @@ -254,40 +254,40 @@ OPCODE(p_cut_by_x ,xl), OPCODE(p_cut_by_y ,yl), OPCODE(p_plus_vv ,xxx), - OPCODE(p_plus_vc ,xxc), + OPCODE(p_plus_vc ,xxn), OPCODE(p_plus_y_vv ,yxx), OPCODE(p_plus_y_vc ,yxc), OPCODE(p_minus_vv ,xxx), - OPCODE(p_minus_cv ,xxc), + OPCODE(p_minus_cv ,xxn), OPCODE(p_minus_y_vv ,yxx), OPCODE(p_minus_y_cv ,yxc), OPCODE(p_times_vv ,xxx), - OPCODE(p_times_vc ,xxc), + OPCODE(p_times_vc ,xxn), OPCODE(p_times_y_vv ,yxx), OPCODE(p_times_y_vc ,yxc), OPCODE(p_div_vv ,xxx), - OPCODE(p_div_vc ,xxc), - OPCODE(p_div_cv ,xxc), + OPCODE(p_div_vc ,xxn), + OPCODE(p_div_cv ,xxn), OPCODE(p_div_y_vv ,yxx), OPCODE(p_div_y_vc ,yxc), OPCODE(p_div_y_cv ,yxc), OPCODE(p_and_vv ,xxx), - OPCODE(p_and_vc ,xxc), + OPCODE(p_and_vc ,xxn), OPCODE(p_and_y_vv ,yxx), OPCODE(p_and_y_vc ,yxc), OPCODE(p_or_vv ,xxx), - OPCODE(p_or_vc ,xxc), + OPCODE(p_or_vc ,xxn), OPCODE(p_or_y_vv ,yxx), OPCODE(p_or_y_vc ,yxc), OPCODE(p_sll_vv ,xxx), - OPCODE(p_sll_vc ,xxc), - OPCODE(p_sll_cv ,xxc), + OPCODE(p_sll_vc ,xxn), + OPCODE(p_sll_cv ,xxn), OPCODE(p_sll_y_vv ,yxx), OPCODE(p_sll_y_vc ,yxc), OPCODE(p_sll_y_cv ,yxc), OPCODE(p_slr_vv ,xxx), - OPCODE(p_slr_vc ,xxc), - OPCODE(p_slr_cv ,xxc), + OPCODE(p_slr_vc ,xxn), + OPCODE(p_slr_cv ,xxn), OPCODE(p_slr_y_vv ,yxx), OPCODE(p_slr_y_vc ,yxc), OPCODE(p_slr_y_cv ,yxc), @@ -299,12 +299,12 @@ OPCODE(p_dif ,l), OPCODE(p_eq ,l), OPCODE(p_arg_vv ,xxx), - OPCODE(p_arg_cv ,xxc), + OPCODE(p_arg_cv ,xxn), OPCODE(p_arg_y_vv ,yxx), - OPCODE(p_arg_y_cv ,xxc), + OPCODE(p_arg_y_cv ,yxc), OPCODE(p_func2s_vv ,xxx), - OPCODE(p_func2s_cv ,xxc), - OPCODE(p_func2s_vc ,xxc), + OPCODE(p_func2s_cv ,xxn), + OPCODE(p_func2s_vc ,xxn), OPCODE(p_func2s_y_vv ,yxx), OPCODE(p_func2s_y_cv ,yxc), OPCODE(p_func2s_y_vc ,yxc), diff --git a/H/amidefs.h b/H/amidefs.h index 3ac7956e1..b8b183402 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -174,6 +174,7 @@ typedef enum { l: label, yamop * L: logic upd clause, logic_upd_clause * m: module, Term + n: number, Integer o: opcode, OPCODE p: predicate, struct pred_entry * s: small integer, COUNT @@ -184,7 +185,7 @@ typedef enum { /* This declaration is going to be parsed by a Prolog program, so: comments are welcome, but they should take a whole line, every field declaration should also take a single line, - please check the Prolog program if you come up with something not unsignd or struct. + please check the Prolog program if you come up with a compilcated C-type that does not start by unsigned or struct. */ typedef struct yami { OPCODE opc; @@ -572,9 +573,9 @@ typedef struct yami { struct { wamreg x; wamreg xi; - COUNT c; + Int c; CELL next; - } xxc; + } xxn; struct { wamreg x; yslot y; diff --git a/H/rclause.h b/H/rclause.h index 83ce2ba2a..237e3aafc 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -1,144 +1,7 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: rclause.h * -* comments: walk through a clause * -* * -* Last rev: $Date: 2008-05-12 14:04:23 $,$Author: vsc $ * -* $Log: not supported by cvs2svn $ -* Revision 1.25 2008/04/01 08:42:46 vsc -* fix restore and small VISTA thingies -* -* Revision 1.24 2008/03/25 22:03:14 vsc -* fix some icc warnings -* -* Revision 1.23 2008/01/28 18:12:36 vsc -* fix small bug in restore opcode -* -* Revision 1.22 2008/01/23 17:57:55 vsc -* valgrind it! -* enable atom garbage collection. -* -* Revision 1.21 2007/11/26 23:43:09 vsc -* fixes to support threads and assert correctly, even if inefficiently. -* -* Revision 1.20 2007/11/07 09:25:27 vsc -* speedup meta-calls -* -* Revision 1.19 2007/11/06 17:02:12 vsc -* compile ground terms away. -* -* Revision 1.18 2006/11/27 17:42:03 vsc -* support for UNICODE, and other bug fixes. -* -* Revision 1.17 2006/10/10 14:08:17 vsc -* small fixes on threaded implementation. -* -* Revision 1.16 2006/09/20 20:03:51 vsc -* improve indexing on floats -* fix sending large lists to DB -* -* Revision 1.15 2006/04/27 14:13:24 rslopes -* *** empty log message *** -* -* Revision 1.14 2005/12/17 03:25:39 vsc -* major changes to support online event-based profiling -* improve error discovery and restart on scanner. -* -* Revision 1.13 2005/11/24 15:35:29 tiagosoares -* removed some compilation warnings related to the cut-c code -* -* Revision 1.12 2005/09/19 19:14:50 vsc -* fix two instructions that were being read badly: op_fail and -* switch_list_nl. -* -* Revision 1.11 2005/09/08 21:55:47 rslopes -* BEAM for YAP update... -* -* Revision 1.10 2005/08/01 15:40:38 ricroc -* TABLING NEW: better support for incomplete tabling -* -* Revision 1.9 2005/07/06 19:34:11 ricroc -* TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure. -* -* Revision 1.8 2005/07/06 15:10:15 vsc -* improvements to compiler: merged instructions and fixes for -> -* -* Revision 1.7 2005/06/04 07:26:43 ricroc -* long int support for tabling -* -* Revision 1.6 2005/06/03 08:18:25 ricroc -* float support for tabling -* -* Revision 1.5 2005/06/01 20:25:23 vsc -* == and \= should not need a choice-point in -> -* -* Revision 1.4 2005/06/01 14:02:52 vsc -* get_rid of try_me?, retry_me? and trust_me? instructions: they are not -* significantly used nowadays. -* -* Revision 1.3 2005/05/30 03:26:37 vsc -* add some atom gc fixes -* -* Revision 1.2 2005/04/10 04:01:13 vsc -* bug fixes, I hope! -* -* Revision 1.1 2005/01/04 02:50:21 vsc -* - allow MegaClauses with blobs -* - change Diffs to be thread specific -* - include Christian's updates -* -* Revision 1.47 2004/12/02 06:06:47 vsc -* fix threads so that they at least start -* allow error handling to work with threads -* replace heap_base by Yap_heap_base, according to Yap's convention for globals. -* -* Revision 1.46 2004/11/23 21:16:21 vsc -* A few extra fixes for saved states. -* -* Revision 1.45 2004/10/26 20:16:18 vsc -* More bug fixes for overflow handling -* -* Revision 1.44 2004/10/06 16:55:47 vsc -* change configure to support big mem configs -* get rid of extra globals -* fix trouble with multifile preds -* -* Revision 1.43 2004/09/27 20:45:04 vsc -* Mega clauses -* Fixes to sizeof(expand_clauses) which was being overestimated -* Fixes to profiling+indexing -* Fixes to reallocation of memory after restoring -* Make sure all clauses, even for C, end in _Ystop -* Don't reuse space for Streams -* Fix Stream_F on StreaNo+1 -* -* Revision 1.42 2004/06/05 03:37:00 vsc -* coroutining is now a part of attvars. -* some more fixes. -* -* Revision 1.41 2004/04/29 03:45:50 vsc -* fix garbage collection in execute_tail -* -* Revision 1.40 2004/03/31 01:03:10 vsc -* support expand group of clauses -* -* Revision 1.39 2004/03/19 11:35:42 vsc -* trim_trail for default machine -* be more aggressive about try-retry-trust chains. -* - handle cases where block starts with a wait -* - don't use _killed instructions, just let the thing rot by itself. -* * -* * -*************************************************************************/ + /* This file was generated automatically by "yap -L misc/buildops" + please do not update */ + static void restore_opcodes(yamop *pc) @@ -150,762 +13,201 @@ restore_opcodes(yamop *pc) fprintf(stderr, "%s ", Yap_op_names[op]); #endif switch (op) { - case _Nstop: - return; - case _Ystop: -#ifdef DEBUG_RESTORE2 - fprintf(stderr, "OK\n"); + /* instructions type ILl */ + case _count_trust_logical: + case _profiled_trust_logical: + case _trust_logical: + pc->u.ILl.block = PtoLUIndexAdjust(pc->u.ILl.block); + pc->u.ILl.d = PtoLUClauseAdjust(pc->u.ILl.d); + pc->u.ILl.n = PtoOpAdjust(pc->u.ILl.n); + pc = NEXTOP(pc,ILl); + break; + /* instructions type Ills */ + case _enter_lu_pred: + pc->u.Ills.I = PtoLUIndexAdjust(pc->u.Ills.I); + pc->u.Ills.l1 = PtoOpAdjust(pc->u.Ills.l1); + pc->u.Ills.l2 = PtoOpAdjust(pc->u.Ills.l2); + pc->u.Ills.s = ConstantAdjust(pc->u.Ills.s); + pc = NEXTOP(pc,Ills); + break; + /* instructions type L */ + case _alloc_for_logical_pred: + pc->u.L.ClBase = PtoLUClauseAdjust(pc->u.L.ClBase); + pc = NEXTOP(pc,L); + break; + /* instructions type aLl */ + case _count_retry_logical: + case _profiled_retry_logical: + case _retry_logical: + case _try_logical: + pc->u.aLl.s = ArityAdjust(pc->u.aLl.s); + pc->u.aLl.d = PtoLUClauseAdjust(pc->u.aLl.d); + pc->u.aLl.n = PtoOpAdjust(pc->u.aLl.n); + pc = NEXTOP(pc,aLl); + break; + /* instructions type apFs */ +#ifdef CUT_C + case _cut_c: #endif - pc->u.l.l = PtoOpAdjust(pc->u.l.l); - return; - /* instructions type ld */ - case _try_me: - case _retry_me: - case _trust_me: - case _profiled_retry_me: - case _profiled_trust_me: +#ifdef CUT_C + case _cut_userc: +#endif + case _retry_c: + case _retry_userc: + case _try_c: + case _try_userc: + pc->u.apFs.s = ArityAdjust(pc->u.apFs.s); + pc->u.apFs.p = PtoPredAdjust(pc->u.apFs.p); + pc->u.apFs.f = ExternalFunctionAdjust(pc->u.apFs.f); + pc->u.apFs.extra = ConstantAdjust(pc->u.apFs.extra); + pc = NEXTOP(pc,apFs); + break; + /* instructions type apl */ + case _count_retry_and_mark: case _count_retry_me: case _count_trust_me: - case _spy_or_trymark: - case _try_and_mark: case _profiled_retry_and_mark: - case _count_retry_and_mark: - case _retry_and_mark: - case _try_clause: + case _profiled_retry_me: + case _profiled_trust_me: case _retry: + case _retry_and_mark: + case _retry_me: + case _spy_or_trymark: case _trust: -#ifdef YAPOR - case _getwork: - case _getwork_seq: - case _sync: -#endif -#ifdef TABLING - case _table_load_answer: - case _table_try_answer: - case _table_try_single: - case _table_try_me: - case _table_retry_me: - case _table_trust_me: - case _table_try: - case _table_retry: - case _table_trust: - case _table_answer_resolution: - case _table_completion: -#endif /* TABLING */ + case _trust_me: + case _try_and_mark: + case _try_clause: + case _try_me: + pc->u.apl.s = ArityAdjust(pc->u.apl.s); pc->u.apl.p = PtoPredAdjust(pc->u.apl.p); pc->u.apl.d = PtoOpAdjust(pc->u.apl.d); pc = NEXTOP(pc,apl); break; - case _try_logical: - case _retry_logical: - case _count_retry_logical: - case _profiled_retry_logical: - pc->u.aLl.n = PtoOpAdjust(pc->u.aLl.n); - pc->u.aLl.d = PtoLUClauseAdjust(pc->u.aLl.d); - pc = pc->u.aLl.n; - break; - case _trust_logical: - case _count_trust_logical: - case _profiled_trust_logical: - pc->u.ILl.n = PtoOpAdjust(pc->u.ILl.n); - pc->u.ILl.d = PtoLUClauseAdjust(pc->u.ILl.d); - pc->u.ILl.block = PtoLUIndexAdjust(pc->u.ILl.block); - return; - case _enter_lu_pred: - pc->u.Ills.I = (LogUpdIndex *)PtoOpAdjust((yamop *)(pc->u.Ills.I)); - pc->u.Ills.l1 = PtoOpAdjust(pc->u.Ills.l1); - pc->u.Ills.l2 = PtoOpAdjust(pc->u.Ills.l2); - pc = pc->u.Ills.l1; - break; - /* instructions type p */ -#if !defined(YAPOR) - case _or_last: -#endif - case _enter_profiling: - case _retry_profiled: - case _lock_lu: - case _count_call: - case _count_retry: - case _procceed: - pc->u.p.p = PtoPredAdjust(pc->u.p.p); - pc = NEXTOP(pc,p); - break; - case _execute: - case _dexecute: - case _execute_cpred: - pc->u.pp.p = PtoPredAdjust(pc->u.pp.p); - pc->u.pp.p0 = PtoPredAdjust(pc->u.pp.p0); - pc = NEXTOP(pc,pp); - break; - case _jump: - case _move_back: - case _skip: - case _jump_if_var: - case _try_in: - case _try_clause2: - case _try_clause3: - case _try_clause4: - case _retry2: - case _retry3: - case _retry4: - case _p_eq: - case _p_dif: - pc->u.l.l = PtoOpAdjust(pc->u.l.l); - pc = NEXTOP(pc,l); - break; - /* instructions type EC */ - case _jump_if_nonvar: - pc->u.xll.l1 = PtoOpAdjust(pc->u.xll.l1); - pc->u.xll.l2 = PtoOpAdjust(pc->u.xll.l2); - pc->u.xll.x = XAdjust(pc->u.xll.x); - pc = NEXTOP(pc,xll); - break; - /* instructions type L */ - case _alloc_for_logical_pred: - pc->u.L.ClBase = (struct logic_upd_clause *)PtoOpAdjust((yamop *)pc->u.L.ClBase); - pc = NEXTOP(pc,L); - break; - /* instructions type e */ - case _unify_idb_term: - case _copy_idb_term: - /* don't need no _Ystop to know we're done */ - return; - case _trust_fail: - case _op_fail: - case _cut: - case _cut_t: - case _cut_e: - case _allocate: - case _deallocate: - case _write_void: - case _write_list: - case _write_l_list: - case _pop: - case _index_pred: - case _lock_pred: -#ifdef BEAM - case _retry_eam: -#endif -#ifdef THREADS - case _thread_local: -#endif - case _expand_index: - case _undef_p: - case _spy_pred: - case _p_equal: - case _p_functor: - case _enter_a_profiling: - case _count_a_call: - case _index_dbref: - case _index_blob: - case _unlock_lu: -#ifdef YAPOR - case _getwork_first_time: -#endif -#ifdef TABLING - case _trie_do_null: - case _trie_trust_null: - case _trie_try_null: - case _trie_retry_null: - case _trie_do_var: - case _trie_trust_var: - case _trie_try_var: - case _trie_retry_var: - case _trie_do_val: - case _trie_trust_val: - case _trie_try_val: - case _trie_retry_val: - case _trie_do_atom: - case _trie_trust_atom: - case _trie_try_atom: - case _trie_retry_atom: - case _trie_do_list: - case _trie_trust_list: - case _trie_try_list: - case _trie_retry_list: - case _trie_do_struct: - case _trie_trust_struct: - case _trie_try_struct: - case _trie_retry_struct: - case _trie_do_extension: - case _trie_trust_extension: - case _trie_try_extension: - case _trie_retry_extension: - case _trie_do_float: - case _trie_trust_float: - case _trie_try_float: - case _trie_retry_float: - case _trie_do_long: - case _trie_trust_long: - case _trie_try_long: - case _trie_retry_long: -#endif /* TABLING */ -#ifdef TABLING_INNER_CUTS - case _clause_with_cut: -#endif /* TABLING_INNER_CUTS */ - pc = NEXTOP(pc,e); - break; - /* instructions type x */ - case _save_b_x: - case _commit_b_x: - case _get_list: - case _put_list: - case _write_x_var: - case _write_x_val: - case _write_x_loc: - pc->u.x.x = XAdjust(pc->u.x.x); - pc = NEXTOP(pc,x); - break; - /* instructions type xl */ - case _p_atom_x: - case _p_atomic_x: - case _p_integer_x: - case _p_nonvar_x: - case _p_number_x: - case _p_var_x: - case _p_db_ref_x: - case _p_primitive_x: - case _p_compound_x: - case _p_float_x: - case _p_cut_by_x: - pc->u.xl.x = XAdjust(pc->u.xl.x); - pc->u.xl.F = PtoOpAdjust(pc->u.xl.F); - pc = NEXTOP(pc,xl); - break; - case _expand_clauses: - Yap_Error(SYSTEM_ERROR, TermNil, - "Invalid Opcode expand_clauses at %p", pc); - break; - /* instructions type y */ - case _save_b_y: - case _commit_b_y: - case _write_y_var: - case _write_y_val: - case _write_y_loc: - pc->u.y.y = YAdjust(pc->u.y.y); - pc = NEXTOP(pc,y); - break; - /* instructions type yl */ - case _p_atom_y: - case _p_atomic_y: - case _p_integer_y: - case _p_nonvar_y: - case _p_number_y: - case _p_var_y: - case _p_db_ref_y: - case _p_primitive_y: - case _p_compound_y: - case _p_float_y: - case _p_cut_by_y: - pc->u.yl.y = YAdjust(pc->u.yl.y); - pc->u.yl.F = PtoOpAdjust(pc->u.yl.F); - pc = NEXTOP(pc,yl); - break; - /* instructions type sbpp */ - case _p_execute: - if (pc->u.sbmp.mod != 0) { - pc->u.sbmp.mod = AtomTermAdjust(pc->u.sbmp.mod); - } - pc->u.sbmp.p0 = PtoPredAdjust(pc->u.sbmp.p0); - if (pc->u.sbmp.bmap != NULL) { - pc->u.sbmp.bmap = CellPtoHeapAdjust(pc->u.sbmp.bmap); - } - pc = NEXTOP(pc,sbmp); - break; - case _p_execute_tail: - case _p_execute2: - pc->u.sbpp.p = PtoPredAdjust(pc->u.sbpp.p); - pc->u.sbpp.p0 = PtoPredAdjust(pc->u.sbpp.p0); - if (pc->u.sbpp.bmap != NULL) { - pc->u.sbpp.bmap = CellPtoHeapAdjust(pc->u.sbpp.bmap); - } - pc = NEXTOP(pc,sbpp); - break; - case _fcall: - case _call: -#ifdef YAPOR - case _or_last: -#endif - pc->u.sbpp.p = PtoPredAdjust(pc->u.sbpp.p); - if (pc->u.sbpp.bmap != NULL) { - pc->u.sbpp.bmap = CellPtoHeapAdjust(pc->u.sbpp.bmap); - } - pc->u.sbpp.p0 = PtoPredAdjust(pc->u.sbpp.p0); - pc = NEXTOP(pc,sbpp); - break; - /* instructions type sbpp, but for disjunctions */ - case _either: - case _or_else: - if (pc->u.sblp.bmap != NULL) { - pc->u.sblp.bmap = CellPtoHeapAdjust(pc->u.sblp.bmap); - } - pc->u.sblp.l = PtoOpAdjust(pc->u.sblp.l); - pc->u.sblp.p0 = PtoPredAdjust(pc->u.sblp.p0); - pc = NEXTOP(pc,sblp); - break; - /* instructions type sbpp, but for functions */ - case _call_cpred: - case _call_usercpred: - pc->u.sbpp.p = PtoPredAdjust(pc->u.sbpp.p); - pc->u.sbpp.p0 = PtoPredAdjust(pc->u.sbpp.p0); - if (pc->u.sbpp.bmap != NULL) { - pc->u.sbpp.bmap = CellPtoHeapAdjust(pc->u.sbpp.bmap); - } - pc = NEXTOP(pc,sbpp); - break; - /* instructions type xx */ - case _get_x_var: - case _get_x_val: - case _glist_valx: - case _gl_void_varx: - case _gl_void_valx: - case _put_x_var: - case _put_x_val: - pc->u.xx.xr = XAdjust(pc->u.xx.xr); - pc->u.xx.xl = XAdjust(pc->u.xx.xl); - pc = NEXTOP(pc,xx); - break; - case _put_xx_val: - pc->u.xxxx.xr1 = XAdjust(pc->u.xxxx.xr1); - pc->u.xxxx.xl1 = XAdjust(pc->u.xxxx.xl1); - pc->u.xxxx.xr2 = XAdjust(pc->u.xxxx.xr2); - pc->u.xxxx.xl2 = XAdjust(pc->u.xxxx.xl2); - pc = NEXTOP(pc,xxxx); - break; - /* instructions type yx */ - case _get_y_var: - case _get_y_val: - case _put_y_var: - case _put_y_val: - case _put_unsafe: - pc->u.yx.x = XAdjust(pc->u.yx.x); - pc->u.yx.y = YAdjust(pc->u.yx.y); - pc = NEXTOP(pc,yx); - break; - /* instructions type xd */ - case _get_float: - case _put_float: - pc->u.xd.x = XAdjust(pc->u.xd.x); - pc = NEXTOP(pc,xd); - break; - /* instructions type xd */ - case _get_longint: - case _put_longint: - pc->u.xi.x = XAdjust(pc->u.xi.x); - pc = NEXTOP(pc,xi); - break; - /* instructions type xc */ - case _get_atom: - case _get_bigint: - pc->u.xc.x = XAdjust(pc->u.xc.x); - { - Term t = pc->u.xc.c; - if (IsAtomTerm(t)) - pc->u.xc.c = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.xc.c = BlobTermAdjust(t); - } - pc = NEXTOP(pc,xc); - break; - case _put_atom: - pc->u.xc.x = XAdjust(pc->u.xc.x); - { - Term t = pc->u.xc.c; - if (IsAtomTerm(t)) - pc->u.xc.c = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.xc.c = BlobTermAdjust(t); - else if (IsPairTerm(t)) - pc->u.xc.c = CodeComposedTermAdjust(t); - } - pc = NEXTOP(pc,xc); - break; - case _get_dbterm: - pc->u.xc.x = XAdjust(pc->u.xc.x); - pc->u.xc.c = CodeComposedTermAdjust(pc->u.xc.c); - pc = NEXTOP(pc,xc); + /* instructions type c */ + case _write_atom: + pc->u.c.c = ConstantTermAdjust(pc->u.c.c); + pc = NEXTOP(pc,c); break; + /* instructions type cc */ case _get_2atoms: - { - Term t = pc->u.cc.c1; - if (IsAtomTerm(t)) - pc->u.cc.c1 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cc.c1 = BlobTermAdjust(t); - } - { - Term t = pc->u.cc.c2; - if (IsAtomTerm(t)) - pc->u.cc.c2 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cc.c2 = BlobTermAdjust(t); - } + pc->u.cc.c1 = ConstantTermAdjust(pc->u.cc.c1); + pc->u.cc.c2 = ConstantTermAdjust(pc->u.cc.c2); pc = NEXTOP(pc,cc); break; /* instructions type ccc */ case _get_3atoms: - { - Term t = pc->u.ccc.c1; - if (IsAtomTerm(t)) - pc->u.ccc.c1 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccc.c1 = BlobTermAdjust(t); - } - { - Term t = pc->u.ccc.c2; - if (IsAtomTerm(t)) - pc->u.ccc.c2 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccc.c2 = BlobTermAdjust(t); - } - { - Term t = pc->u.ccc.c3; - if (IsAtomTerm(t)) - pc->u.ccc.c3 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccc.c3 = BlobTermAdjust(t); - } + pc->u.ccc.c1 = ConstantTermAdjust(pc->u.ccc.c1); + pc->u.ccc.c2 = ConstantTermAdjust(pc->u.ccc.c2); + pc->u.ccc.c3 = ConstantTermAdjust(pc->u.ccc.c3); pc = NEXTOP(pc,ccc); break; /* instructions type cccc */ case _get_4atoms: - { - Term t = pc->u.cccc.c1; - if (IsAtomTerm(t)) - pc->u.cccc.c1 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccc.c1 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccc.c2; - if (IsAtomTerm(t)) - pc->u.cccc.c2 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccc.c2 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccc.c3; - if (IsAtomTerm(t)) - pc->u.cccc.c3 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccc.c3 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccc.c4; - if (IsAtomTerm(t)) - pc->u.cccc.c4 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccc.c4 = BlobTermAdjust(t); - } + pc->u.cccc.c1 = ConstantTermAdjust(pc->u.cccc.c1); + pc->u.cccc.c2 = ConstantTermAdjust(pc->u.cccc.c2); + pc->u.cccc.c3 = ConstantTermAdjust(pc->u.cccc.c3); + pc->u.cccc.c4 = ConstantTermAdjust(pc->u.cccc.c4); pc = NEXTOP(pc,cccc); break; /* instructions type ccccc */ case _get_5atoms: - { - Term t = pc->u.ccccc.c1; - if (IsAtomTerm(t)) - pc->u.ccccc.c1 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccccc.c1 = BlobTermAdjust(t); - } - { - Term t = pc->u.ccccc.c2; - if (IsAtomTerm(t)) - pc->u.ccccc.c2 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccccc.c2 = BlobTermAdjust(t); - } - { - Term t = pc->u.ccccc.c3; - if (IsAtomTerm(t)) - pc->u.ccccc.c3 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccccc.c3 = BlobTermAdjust(t); - } - { - Term t = pc->u.ccccc.c4; - if (IsAtomTerm(t)) - pc->u.ccccc.c4 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccccc.c4 = BlobTermAdjust(t); - } - { - Term t = pc->u.ccccc.c5; - if (IsAtomTerm(t)) - pc->u.ccccc.c5 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.ccccc.c5 = BlobTermAdjust(t); - } + pc->u.ccccc.c1 = ConstantTermAdjust(pc->u.ccccc.c1); + pc->u.ccccc.c2 = ConstantTermAdjust(pc->u.ccccc.c2); + pc->u.ccccc.c3 = ConstantTermAdjust(pc->u.ccccc.c3); + pc->u.ccccc.c4 = ConstantTermAdjust(pc->u.ccccc.c4); + pc->u.ccccc.c5 = ConstantTermAdjust(pc->u.ccccc.c5); pc = NEXTOP(pc,ccccc); break; /* instructions type cccccc */ case _get_6atoms: - { - Term t = pc->u.cccccc.c1; - if (IsAtomTerm(t)) - pc->u.cccccc.c1 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccccc.c1 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccccc.c2; - if (IsAtomTerm(t)) - pc->u.cccccc.c2 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccccc.c2 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccccc.c3; - if (IsAtomTerm(t)) - pc->u.cccccc.c3 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccccc.c3 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccccc.c4; - if (IsAtomTerm(t)) - pc->u.cccccc.c4 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccccc.c4 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccccc.c5; - if (IsAtomTerm(t)) - pc->u.cccccc.c5 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccccc.c5 = BlobTermAdjust(t); - } - { - Term t = pc->u.cccccc.c6; - if (IsAtomTerm(t)) - pc->u.cccccc.c6 = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.cccccc.c6 = BlobTermAdjust(t); - } + pc->u.cccccc.c1 = ConstantTermAdjust(pc->u.cccccc.c1); + pc->u.cccccc.c2 = ConstantTermAdjust(pc->u.cccccc.c2); + pc->u.cccccc.c3 = ConstantTermAdjust(pc->u.cccccc.c3); + pc->u.cccccc.c4 = ConstantTermAdjust(pc->u.cccccc.c4); + pc->u.cccccc.c5 = ConstantTermAdjust(pc->u.cccccc.c5); + pc->u.cccccc.c6 = ConstantTermAdjust(pc->u.cccccc.c6); pc = NEXTOP(pc,cccccc); break; - /* instructions type xfa */ - case _get_struct: - case _put_struct: - pc->u.xfa.x = XAdjust(pc->u.xfa.x); - pc->u.xfa.f = FuncAdjust(pc->u.xfa.f); - pc = NEXTOP(pc,xfa); - break; - /* instructions type xy */ - case _glist_valy: - case _gl_void_vary: - case _gl_void_valy: - pc->u.xy.x = XAdjust(pc->u.xy.x); - pc->u.xy.y = YAdjust(pc->u.xy.y); - pc = NEXTOP(pc,xy); - break; - /* instructions type ox */ - case _unify_x_var: - case _unify_x_var_write: - case _unify_l_x_var: - case _unify_l_x_var_write: - case _unify_x_val_write: - case _unify_x_val: - case _unify_l_x_val_write: - case _unify_l_x_val: - case _unify_x_loc_write: - case _unify_x_loc: - case _unify_l_x_loc_write: - case _unify_l_x_loc: - case _save_pair_x_write: - case _save_pair_x: - case _save_appl_x_write: - case _save_appl_x: - pc->u.ox.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.ox.opcw)); - pc->u.ox.x = XAdjust(pc->u.ox.x); - pc = NEXTOP(pc,ox); - break; - /* instructions type oxx */ - case _unify_x_var2: - case _unify_x_var2_write: - case _unify_l_x_var2: - case _unify_l_x_var2_write: - pc->u.oxx.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oxx.opcw)); - pc->u.oxx.xl = XAdjust(pc->u.oxx.xl); - pc->u.oxx.xr = XAdjust(pc->u.oxx.xr); - pc = NEXTOP(pc,oxx); - break; - /* instructions type oy */ - case _unify_y_var: - case _unify_y_var_write: - case _unify_l_y_var: - case _unify_l_y_var_write: - case _unify_y_val_write: - case _unify_y_val: - case _unify_l_y_val_write: - case _unify_l_y_val: - case _unify_y_loc_write: - case _unify_y_loc: - case _unify_l_y_loc_write: - case _unify_l_y_loc: - case _save_pair_y_write: - case _save_pair_y: - case _save_appl_y_write: - case _save_appl_y: - pc->u.oy.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oy.opcw)); - pc->u.oy.y = YAdjust(pc->u.oy.y); - pc = NEXTOP(pc,oy); - break; - /* instructions type o */ - case _unify_void_write: - case _unify_void: - case _unify_l_void_write: - case _unify_l_void: - case _unify_list_write: - case _unify_list: - case _unify_l_list_write: - case _unify_l_list: - pc->u.o.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.o.opcw)); - pc = NEXTOP(pc,o); - break; - /* instructions type os */ - case _unify_n_voids_write: - case _unify_n_voids: - case _unify_l_n_voids_write: - case _unify_l_n_voids: - pc->u.os.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.os.opcw)); - pc = NEXTOP(pc,os); - break; - /* instructions type od */ - case _unify_float: - case _unify_l_float: - case _unify_float_write: - case _unify_l_float_write: - pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw)); - pc = NEXTOP(pc,od); - break; - /* instructions type oi */ - case _unify_longint: - case _unify_l_longint: - case _unify_longint_write: - case _unify_l_longint_write: - pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw)); - pc = NEXTOP(pc,oi); - break; - /* instructions type oc */ - case _unify_dbterm: - case _unify_l_dbterm: - pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw)); - pc->u.oc.c = CodeComposedTermAdjust(pc->u.oc.c); - pc = NEXTOP(pc,oc); - break; - case _unify_atom_write: - case _unify_atom: - case _unify_l_atom_write: - case _unify_l_atom: - case _unify_bigint: - case _unify_l_bigint: - pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw)); - { - Term t = pc->u.oc.c; - if (IsAtomTerm(t)) - pc->u.oc.c = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.oc.c = BlobTermAdjust(t); - } - pc = NEXTOP(pc,oc); - break; - /* instructions type osc */ - case _unify_n_atoms_write: - case _unify_n_atoms: - pc->u.osc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.osc.opcw)); - { - Term t = pc->u.osc.c; - if (IsAtomTerm(t)) - pc->u.osc.c = AtomTermAdjust(t); - } - pc = NEXTOP(pc,osc); - break; - /* instructions type ofa */ - case _unify_struct_write: - case _unify_struct: - case _unify_l_struc_write: - case _unify_l_struc: - pc->u.ofa.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.ofa.opcw)); - pc->u.ofa.f = FuncAdjust(pc->u.ofa.f); - pc = NEXTOP(pc,ofa); - break; - /* instructions type s */ - case _write_n_voids: - case _pop_n: -#ifdef BEAM - case _run_eam: -#endif -#ifdef TABLING - case _table_new_answer: -#endif /* TABLING */ - pc = NEXTOP(pc,s); + /* instructions type clll */ + case _if_not_then: + pc->u.clll.c = ConstantTermAdjust(pc->u.clll.c); + pc->u.clll.l1 = PtoOpAdjust(pc->u.clll.l1); + pc->u.clll.l2 = PtoOpAdjust(pc->u.clll.l2); + pc->u.clll.l3 = PtoOpAdjust(pc->u.clll.l3); + pc = NEXTOP(pc,clll); break; /* instructions type d */ case _write_float: + DoubleInCodeAdjust(pc->u.d.d); pc = NEXTOP(pc,d); break; + /* instructions type e */ + case _Nstop: + case _allocate: + case _copy_idb_term: + case _count_a_call: + case _cut: + case _cut_e: + case _cut_t: + case _deallocate: + case _enter_a_profiling: + case _expand_index: + case _index_blob: + case _index_dbref: + case _index_pred: + case _lock_pred: + case _op_fail: + case _p_equal: + case _p_functor: + case _pop: +#ifdef BEAM + case _retry_eam: +#endif + case _spy_pred: +#ifdef THREADS + case _thread_local: +#endif + case _trust_fail: + case _undef_p: + case _unify_idb_term: + case _unlock_lu: + case _write_l_list: + case _write_list: + case _write_void: + if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return; + pc = NEXTOP(pc,e); + break; + /* instructions type fa */ + case _write_l_struc: + case _write_struct: + pc->u.fa.f = FuncAdjust(pc->u.fa.f); + pc->u.fa.a = ArityAdjust(pc->u.fa.a); + pc = NEXTOP(pc,fa); + break; /* instructions type i */ case _write_longint: + IntegerInCodeAdjust(pc->u.i.i); pc = NEXTOP(pc,i); break; - /* instructions type c */ - case _write_atom: - { - Term t = pc->u.c.c; - if (IsAtomTerm(t)) - pc->u.c.c = AtomTermAdjust(t); - else if (IsApplTerm(t)) - pc->u.c.c = BlobTermAdjust(t); - else if (IsPairTerm(t)) - pc->u.c.c = CodeComposedTermAdjust(t); - } - pc = NEXTOP(pc,c); + /* instructions type l */ + case _Ystop: + case _jump: + case _jump_if_var: + case _move_back: + case _p_dif: + case _p_eq: + case _retry2: + case _retry3: + case _retry4: + case _skip: + case _try_clause2: + case _try_clause3: + case _try_clause4: + case _try_in: + pc->u.l.l = PtoOpAdjust(pc->u.l.l); + if (op == _Ystop) return; + pc = NEXTOP(pc,l); break; - /* instructions type sc */ - case _write_n_atoms: - { - Term t = pc->u.sc.c; - if (IsAtomTerm(t)) - pc->u.sc.c = AtomTermAdjust(t); - } - pc = NEXTOP(pc,sc); - break; - /* instructions type f */ - case _write_struct: - case _write_l_struc: - pc->u.fa.f = FuncAdjust(pc->u.fa.f); - pc = NEXTOP(pc,fa); - break; - /* instructions type sdlp */ - case _call_c_wfail: - pc->u.sdlp.p = PtoPredAdjust(pc->u.sdlp.p); - pc->u.sdlp.l = PtoOpAdjust(pc->u.sdlp.l); - pc = NEXTOP(pc,sdlp); - break; - /* instructions type apFs */ - case _try_c: - case _try_userc: - /* don't need to do no nothing here, initstaff will do it for us - */ - pc->u.apFs.p = PtoPredAdjust(pc->u.apFs.p); - pc = NEXTOP(pc,apFs); - break; - case _retry_c: - case _retry_userc: - /* don't need to do no nothing here, initstaff will do it for us - pc->u.apFs.d = CCodeAdjust(pc->u.apFs.d); */ - pc->u.apFs.p = PtoPredAdjust(pc->u.apFs.p); - pc = NEXTOP(pc,apFs); - break; -#ifdef CUT_C - case _cut_c: - case _cut_userc: - /* don't need to do nothing here, because this two instructions - are "phantom" instructions. (see: cut_c implementation paper - on PADL 2006) */ - break; -#endif /* instructions type llll */ case _switch_on_type: pc->u.llll.l1 = PtoOpAdjust(pc->u.llll.l1); @@ -914,15 +216,335 @@ restore_opcodes(yamop *pc) pc->u.llll.l4 = PtoOpAdjust(pc->u.llll.l4); pc = NEXTOP(pc,llll); break; - /* instructions type xllll */ + /* instructions type o */ + case _unify_l_list: + case _unify_l_list_write: + case _unify_l_void: + case _unify_l_void_write: + case _unify_list: + case _unify_list_write: + case _unify_void: + case _unify_void_write: + pc->u.o.opcw = OpcodeAdjust(pc->u.o.opcw); + pc = NEXTOP(pc,o); + break; + /* instructions type oc */ + case _unify_atom: + case _unify_atom_write: + case _unify_bigint: + case _unify_dbterm: + case _unify_l_atom: + case _unify_l_atom_write: + case _unify_l_bigint: + case _unify_l_dbterm: + pc->u.oc.opcw = OpcodeAdjust(pc->u.oc.opcw); + pc->u.oc.c = ConstantTermAdjust(pc->u.oc.c); + pc = NEXTOP(pc,oc); + break; + /* instructions type od */ + case _unify_float: + case _unify_float_write: + case _unify_l_float: + case _unify_l_float_write: + pc->u.od.opcw = OpcodeAdjust(pc->u.od.opcw); + DoubleInCodeAdjust(pc->u.od.d); + pc = NEXTOP(pc,od); + break; + /* instructions type ofa */ + case _unify_l_struc: + case _unify_l_struc_write: + case _unify_struct: + case _unify_struct_write: + pc->u.ofa.opcw = OpcodeAdjust(pc->u.ofa.opcw); + pc->u.ofa.f = FuncAdjust(pc->u.ofa.f); + pc->u.ofa.a = ArityAdjust(pc->u.ofa.a); + pc = NEXTOP(pc,ofa); + break; + /* instructions type oi */ + case _unify_l_longint: + case _unify_l_longint_write: + case _unify_longint: + case _unify_longint_write: + pc->u.oi.opcw = OpcodeAdjust(pc->u.oi.opcw); + IntegerInCodeAdjust(pc->u.oi.i); + pc = NEXTOP(pc,oi); + break; + /* instructions type ollll */ case _switch_list_nl: - pc->u.ollll.pop = Yap_opcode(Yap_op_from_opcode(pc->u.ollll.pop)); + pc->u.ollll.pop = OpcodeAdjust(pc->u.ollll.pop); pc->u.ollll.l1 = PtoOpAdjust(pc->u.ollll.l1); pc->u.ollll.l2 = PtoOpAdjust(pc->u.ollll.l2); pc->u.ollll.l3 = PtoOpAdjust(pc->u.ollll.l3); pc->u.ollll.l4 = PtoOpAdjust(pc->u.ollll.l4); pc = NEXTOP(pc,ollll); break; + /* instructions type os */ +#ifdef BEAM + case _run_eam: +#endif + case _unify_l_n_voids: + case _unify_l_n_voids_write: + case _unify_n_voids: + case _unify_n_voids_write: + pc->u.os.opcw = OpcodeAdjust(pc->u.os.opcw); + pc->u.os.s = ConstantAdjust(pc->u.os.s); + pc = NEXTOP(pc,os); + break; + /* instructions type osc */ + case _unify_n_atoms: + case _unify_n_atoms_write: + pc->u.osc.opcw = OpcodeAdjust(pc->u.osc.opcw); + pc->u.osc.s = ConstantAdjust(pc->u.osc.s); + pc->u.osc.c = ConstantTermAdjust(pc->u.osc.c); + pc = NEXTOP(pc,osc); + break; + /* instructions type ox */ + case _save_appl_x: + case _save_appl_x_write: + case _save_pair_x: + case _save_pair_x_write: + case _unify_l_x_loc: + case _unify_l_x_loc_write: + case _unify_l_x_val: + case _unify_l_x_val_write: + case _unify_l_x_var: + case _unify_l_x_var_write: + case _unify_x_loc: + case _unify_x_loc_write: + case _unify_x_val: + case _unify_x_val_write: + case _unify_x_var: + case _unify_x_var_write: + pc->u.ox.opcw = OpcodeAdjust(pc->u.ox.opcw); + pc->u.ox.x = XAdjust(pc->u.ox.x); + pc = NEXTOP(pc,ox); + break; + /* instructions type oxx */ + case _unify_l_x_var2: + case _unify_l_x_var2_write: + case _unify_x_var2: + case _unify_x_var2_write: + pc->u.oxx.opcw = OpcodeAdjust(pc->u.oxx.opcw); + pc->u.oxx.xl = XAdjust(pc->u.oxx.xl); + pc->u.oxx.xr = XAdjust(pc->u.oxx.xr); + pc = NEXTOP(pc,oxx); + break; + /* instructions type oy */ + case _save_appl_y: + case _save_appl_y_write: + case _save_pair_y: + case _save_pair_y_write: + case _unify_l_y_loc: + case _unify_l_y_loc_write: + case _unify_l_y_val: + case _unify_l_y_val_write: + case _unify_l_y_var: + case _unify_l_y_var_write: + case _unify_y_loc: + case _unify_y_loc_write: + case _unify_y_val: + case _unify_y_val_write: + case _unify_y_var: + case _unify_y_var_write: + pc->u.oy.opcw = OpcodeAdjust(pc->u.oy.opcw); + pc->u.oy.y = YAdjust(pc->u.oy.y); + pc = NEXTOP(pc,oy); + break; + /* instructions type p */ + case _count_call: + case _count_retry: + case _enter_profiling: + case _lock_lu: + case _procceed: + case _retry_profiled: + pc->u.p.p = PtoPredAdjust(pc->u.p.p); + pc = NEXTOP(pc,p); + break; + /* instructions type plxxs */ + case _call_bfunc_xx: + pc->u.plxxs.p = PtoPredAdjust(pc->u.plxxs.p); + pc->u.plxxs.f = PtoOpAdjust(pc->u.plxxs.f); + pc->u.plxxs.x1 = XAdjust(pc->u.plxxs.x1); + pc->u.plxxs.x2 = XAdjust(pc->u.plxxs.x2); + pc->u.plxxs.flags = ConstantAdjust(pc->u.plxxs.flags); + pc = NEXTOP(pc,plxxs); + break; + /* instructions type plxys */ + case _call_bfunc_xy: + case _call_bfunc_yx: + pc->u.plxys.p = PtoPredAdjust(pc->u.plxys.p); + pc->u.plxys.f = PtoOpAdjust(pc->u.plxys.f); + pc->u.plxys.x = XAdjust(pc->u.plxys.x); + pc->u.plxys.y = YAdjust(pc->u.plxys.y); + pc->u.plxys.flags = ConstantAdjust(pc->u.plxys.flags); + pc = NEXTOP(pc,plxys); + break; + /* instructions type plyys */ + case _call_bfunc_yy: + pc->u.plyys.p = PtoPredAdjust(pc->u.plyys.p); + pc->u.plyys.f = PtoOpAdjust(pc->u.plyys.f); + pc->u.plyys.y1 = YAdjust(pc->u.plyys.y1); + pc->u.plyys.y2 = YAdjust(pc->u.plyys.y2); + pc->u.plyys.flags = ConstantAdjust(pc->u.plyys.flags); + pc = NEXTOP(pc,plyys); + break; + /* instructions type pp */ + case _dexecute: + case _execute: + case _execute_cpred: + pc->u.pp.p = PtoPredAdjust(pc->u.pp.p); + pc->u.pp.p0 = PtoPredAdjust(pc->u.pp.p0); + pc = NEXTOP(pc,pp); + break; + /* instructions type s */ + case _pop_n: + case _write_n_voids: + pc->u.s.s = ConstantAdjust(pc->u.s.s); + pc = NEXTOP(pc,s); + break; + /* instructions type sblp */ + case _either: + case _or_else: + pc->u.sblp.s = ConstantAdjust(pc->u.sblp.s); + pc->u.sblp.bmap = CellPtoHeapAdjust(pc->u.sblp.bmap); + pc->u.sblp.l = PtoOpAdjust(pc->u.sblp.l); + pc->u.sblp.p0 = PtoPredAdjust(pc->u.sblp.p0); + pc = NEXTOP(pc,sblp); + break; + /* instructions type sbmp */ + case _p_execute: + pc->u.sbmp.s = ConstantAdjust(pc->u.sbmp.s); + pc->u.sbmp.bmap = CellPtoHeapAdjust(pc->u.sbmp.bmap); + pc->u.sbmp.mod = ModuleAdjust(pc->u.sbmp.mod); + pc->u.sbmp.p0 = PtoPredAdjust(pc->u.sbmp.p0); + pc = NEXTOP(pc,sbmp); + break; + /* instructions type sbpp */ + case _call: + case _call_cpred: + case _call_usercpred: + case _fcall: + case _p_execute2: + case _p_execute_tail: + pc->u.sbpp.s = ConstantAdjust(pc->u.sbpp.s); + pc->u.sbpp.bmap = CellPtoHeapAdjust(pc->u.sbpp.bmap); + pc->u.sbpp.p = PtoPredAdjust(pc->u.sbpp.p); + pc->u.sbpp.p0 = PtoPredAdjust(pc->u.sbpp.p0); + pc = NEXTOP(pc,sbpp); + break; + /* instructions type sc */ + case _write_n_atoms: + pc->u.sc.s = ConstantAdjust(pc->u.sc.s); + pc->u.sc.c = ConstantTermAdjust(pc->u.sc.c); + pc = NEXTOP(pc,sc); + break; + /* instructions type sdlp */ + case _call_c_wfail: + pc->u.sdlp.s = ConstantAdjust(pc->u.sdlp.s); + DoubleInCodeAdjust(pc->u.sdlp.d); + pc->u.sdlp.l = PtoOpAdjust(pc->u.sdlp.l); + pc->u.sdlp.p = PtoPredAdjust(pc->u.sdlp.p); + pc = NEXTOP(pc,sdlp); + break; + /* instructions type sllll */ + case _switch_on_sub_arg_type: + pc->u.sllll.s = ConstantAdjust(pc->u.sllll.s); + pc->u.sllll.l1 = PtoOpAdjust(pc->u.sllll.l1); + pc->u.sllll.l2 = PtoOpAdjust(pc->u.sllll.l2); + pc->u.sllll.l3 = PtoOpAdjust(pc->u.sllll.l3); + pc->u.sllll.l4 = PtoOpAdjust(pc->u.sllll.l4); + pc = NEXTOP(pc,sllll); + break; + /* instructions type sssl */ + case _go_on_cons: + case _go_on_func: + case _if_cons: + case _if_func: + case _switch_on_cons: + case _switch_on_func: + pc->u.sssl.s = ConstantAdjust(pc->u.sssl.s); + pc->u.sssl.e = ConstantAdjust(pc->u.sssl.e); + pc->u.sssl.w = ConstantAdjust(pc->u.sssl.w); + pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l); + AdjustSwitchTable(op, pc->u.sssl.l, pc->u.sssl.s); + pc = NEXTOP(pc,sssl); + break; + /* instructions type sssllp */ + case _expand_clauses: + pc->u.sssllp.s1 = ConstantAdjust(pc->u.sssllp.s1); + pc->u.sssllp.s2 = ConstantAdjust(pc->u.sssllp.s2); + pc->u.sssllp.s3 = ConstantAdjust(pc->u.sssllp.s3); + pc->u.sssllp.sprev = PtoOpAdjust(pc->u.sssllp.sprev); + pc->u.sssllp.snext = PtoOpAdjust(pc->u.sssllp.snext); + pc->u.sssllp.p = PtoPredAdjust(pc->u.sssllp.p); + pc = NEXTOP(pc,sssllp); + break; + /* instructions type x */ + case _commit_b_x: + case _get_list: + case _put_list: + case _save_b_x: + case _write_x_loc: + case _write_x_val: + case _write_x_var: + pc->u.x.x = XAdjust(pc->u.x.x); + pc = NEXTOP(pc,x); + break; + /* instructions type xc */ + case _get_atom: + case _get_bigint: + case _get_dbterm: + case _put_atom: + pc->u.xc.x = XAdjust(pc->u.xc.x); + pc->u.xc.c = ConstantTermAdjust(pc->u.xc.c); + pc = NEXTOP(pc,xc); + break; + /* instructions type xd */ + case _get_float: + case _put_float: + pc->u.xd.x = XAdjust(pc->u.xd.x); + DoubleInCodeAdjust(pc->u.xd.d); + pc = NEXTOP(pc,xd); + break; + /* instructions type xfa */ + case _get_struct: + case _put_struct: + pc->u.xfa.x = XAdjust(pc->u.xfa.x); + pc->u.xfa.f = FuncAdjust(pc->u.xfa.f); + pc->u.xfa.a = ArityAdjust(pc->u.xfa.a); + pc = NEXTOP(pc,xfa); + break; + /* instructions type xi */ + case _get_longint: + case _put_longint: + pc->u.xi.x = XAdjust(pc->u.xi.x); + IntegerInCodeAdjust(pc->u.xi.i); + pc = NEXTOP(pc,xi); + break; + /* instructions type xl */ + case _p_atom_x: + case _p_atomic_x: + case _p_compound_x: + case _p_cut_by_x: + case _p_db_ref_x: + case _p_float_x: + case _p_integer_x: + case _p_nonvar_x: + case _p_number_x: + case _p_number_y: + case _p_primitive_x: + case _p_var_x: + pc->u.xl.x = XAdjust(pc->u.xl.x); + pc->u.xl.F = PtoOpAdjust(pc->u.xl.F); + pc = NEXTOP(pc,xl); + break; + /* instructions type xll */ + case _jump_if_nonvar: + pc->u.xll.x = XAdjust(pc->u.xll.x); + pc->u.xll.l1 = PtoOpAdjust(pc->u.xll.l1); + pc->u.xll.l2 = PtoOpAdjust(pc->u.xll.l2); + pc = NEXTOP(pc,xll); + break; /* instructions type xllll */ case _switch_on_arg_type: pc->u.xllll.x = XAdjust(pc->u.xllll.x); @@ -932,202 +554,145 @@ restore_opcodes(yamop *pc) pc->u.xllll.l4 = PtoOpAdjust(pc->u.xllll.l4); pc = NEXTOP(pc,xllll); break; - /* instructions type sllll */ - case _switch_on_sub_arg_type: - pc->u.sllll.l1 = PtoOpAdjust(pc->u.sllll.l1); - pc->u.sllll.l2 = PtoOpAdjust(pc->u.sllll.l2); - pc->u.sllll.l3 = PtoOpAdjust(pc->u.sllll.l3); - pc->u.sllll.l4 = PtoOpAdjust(pc->u.sllll.l4); - pc = NEXTOP(pc,sllll); + /* instructions type xx */ + case _get_x_val: + case _get_x_var: + case _gl_void_valx: + case _gl_void_varx: + case _glist_valx: + case _put_x_val: + case _put_x_var: + pc->u.xx.xl = XAdjust(pc->u.xx.xl); + pc->u.xx.xr = XAdjust(pc->u.xx.xr); + pc = NEXTOP(pc,xx); break; - /* instructions type lll */ - case _if_not_then: - { - Term t = pc->u.clll.c; - if (IsAtomTerm(t)) - pc->u.clll.c = AtomTermAdjust(t); - } - pc->u.clll.l1 = PtoOpAdjust(pc->u.clll.l1); - pc->u.clll.l2 = PtoOpAdjust(pc->u.clll.l2); - pc->u.clll.l3 = PtoOpAdjust(pc->u.clll.l3); - pc = NEXTOP(pc,clll); - break; - /* switch_on_func */ - case _switch_on_func: - { - int i, j; - CELL *oldcode, *startcode; - - i = pc->u.sssl.s; - startcode = oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); - for (j = 0; j < i; j++) { - Functor oldfunc = (Functor)(oldcode[0]); - CODEADDR oldjmp = (CODEADDR)(oldcode[1]); - if (oldfunc) { - oldcode[0] = (CELL)FuncAdjust(oldfunc); - } - oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); - oldcode += 2; - } - rehash(startcode, i, Funcs); - pc = NEXTOP(pc,sssl); - } - break; - /* switch_on_cons */ - case _switch_on_cons: - { - int i, j; - CELL *oldcode; -#if !defined(USE_OFFSETS) - CELL *startcode; -#endif - - i = pc->u.sssl.s; -#if !defined(USE_OFFSETS) - startcode = -#endif - oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); - for (j = 0; j < i; j++) { - Term oldcons = oldcode[0]; - CODEADDR oldjmp = (CODEADDR)(oldcode[1]); - if (oldcons != 0x0 && IsAtomTerm(oldcons)) { - oldcode[0] = AtomTermAdjust(oldcons); - } - oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); - oldcode += 2; - } -#if !USE_OFFSETS - rehash(startcode, i, Atomics); -#endif - pc = NEXTOP(pc,sssl); - } - break; - case _go_on_func: - { - CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); - Functor oldfunc = (Functor)(oldcode[0]); - - oldcode[0] = (CELL)FuncAdjust(oldfunc); - oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); - oldcode[3] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[3]); - } - pc = NEXTOP(pc,sssl); - break; - case _go_on_cons: - { - CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); - Term oldcons = oldcode[0]; - - if (IsAtomTerm(oldcons)) { - oldcode[0] = AtomTermAdjust(oldcons); - } - oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); - oldcode[3] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[3]); - } - pc = NEXTOP(pc,sssl); - break; - case _if_func: - { - CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); - Int j; - - for (j = 0; j < pc->u.sssl.s; j++) { - Functor oldfunc = (Functor)(oldcode[0]); - CODEADDR oldjmp = (CODEADDR)(oldcode[1]); - oldcode[0] = (CELL)FuncAdjust(oldfunc); - oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); - oldcode += 2; - } - /* adjust fail code */ - oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); - } - pc = NEXTOP(pc,sssl); - break; - case _if_cons: - { - CELL *oldcode = (CELL *)(pc->u.sssl.l = PtoOpAdjust(pc->u.sssl.l)); - Int j; - - for (j = 0; j < pc->u.sssl.s; j++) { - Term oldcons = oldcode[0]; - CODEADDR oldjmp = (CODEADDR)(oldcode[1]); - if (IsAtomTerm(oldcons)) { - oldcode[0] = (CELL)AtomTermAdjust(oldcons); - } - oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); - oldcode += 2; - } - /* adjust fail code */ - oldcode[1] = (CELL)CodeAddrAdjust((CODEADDR)oldcode[1]); - } - pc = NEXTOP(pc,sssl); + /* instructions type xxn */ + case _p_and_vc: + case _p_arg_cv: + case _p_div_cv: + case _p_div_vc: + case _p_func2s_cv: + case _p_func2s_vc: + case _p_minus_cv: + case _p_or_vc: + case _p_plus_vc: + case _p_sll_cv: + case _p_sll_vc: + case _p_slr_cv: + case _p_slr_vc: + case _p_times_vc: + pc->u.xxn.x = XAdjust(pc->u.xxn.x); + pc->u.xxn.xi = XAdjust(pc->u.xxn.xi); + pc->u.xxn.c = IntegerAdjust(pc->u.xxn.c); + pc = NEXTOP(pc,xxn); break; /* instructions type xxx */ - case _p_plus_vv: - case _p_minus_vv: - case _p_times_vv: - case _p_div_vv: case _p_and_vv: + case _p_arg_vv: + case _p_div_vv: + case _p_func2f_xx: + case _p_func2s_vv: + case _p_minus_vv: case _p_or_vv: + case _p_plus_vv: case _p_sll_vv: case _p_slr_vv: - case _p_arg_vv: - case _p_func2s_vv: - case _p_func2f_xx: - pc->u.xxx.x = XAdjust(pc->u.xxx.x); + case _p_times_vv: + pc->u.xxx.x = XAdjust(pc->u.xxx.x); pc->u.xxx.x1 = XAdjust(pc->u.xxx.x1); pc->u.xxx.x2 = XAdjust(pc->u.xxx.x2); pc = NEXTOP(pc,xxx); break; - /* instructions type xxc */ - case _p_plus_vc: - case _p_minus_cv: - case _p_times_vc: - case _p_div_cv: - case _p_and_vc: - case _p_or_vc: - case _p_sll_vc: - case _p_slr_vc: - case _p_func2s_vc: - pc->u.xxc.x = XAdjust(pc->u.xxc.x); - pc->u.xxc.xi = XAdjust(pc->u.xxc.xi); - pc = NEXTOP(pc,xxc); - break; - case _p_div_vc: - case _p_sll_cv: - case _p_slr_cv: - case _p_arg_cv: - pc->u.xxc.x = XAdjust(pc->u.xxc.x); - pc->u.xxc.xi = XAdjust(pc->u.xxc.xi); - pc = NEXTOP(pc,xxc); - break; - case _p_func2s_cv: - pc->u.xxc.x = XAdjust(pc->u.xxc.x); - if (IsAtomTerm(pc->u.xxc.c)) - pc->u.xxc.c = AtomTermAdjust(pc->u.xxc.c); - pc->u.xxc.xi = XAdjust(pc->u.xxc.xi); - pc = NEXTOP(pc,xxc); + /* instructions type xxxx */ + case _put_xx_val: + pc->u.xxxx.xl1 = XAdjust(pc->u.xxxx.xl1); + pc->u.xxxx.xl2 = XAdjust(pc->u.xxxx.xl2); + pc->u.xxxx.xr1 = XAdjust(pc->u.xxxx.xr1); + pc->u.xxxx.xr2 = XAdjust(pc->u.xxxx.xr2); + pc = NEXTOP(pc,xxxx); break; /* instructions type xxy */ case _p_func2f_xy: pc->u.xxy.x = XAdjust(pc->u.xxy.x); pc->u.xxy.x1 = XAdjust(pc->u.xxy.x1); - pc->u.xxy.y2 = YAdjust(pc->u.xxy.y2); + pc->u.xxy.y2 = YAdjust(pc->u.xxy.y2); pc = NEXTOP(pc,xxy); break; + /* instructions type xy */ + case _gl_void_valy: + case _gl_void_vary: + case _glist_valy: + pc->u.xy.x = XAdjust(pc->u.xy.x); + pc->u.xy.y = YAdjust(pc->u.xy.y); + pc = NEXTOP(pc,xy); + break; + /* instructions type y */ + case _commit_b_y: + case _save_b_y: + case _write_y_loc: + case _write_y_val: + case _write_y_var: + pc->u.y.y = YAdjust(pc->u.y.y); + pc = NEXTOP(pc,y); + break; + /* instructions type yl */ + case _p_atom_y: + case _p_atomic_y: + case _p_compound_y: + case _p_cut_by_y: + case _p_db_ref_y: + case _p_float_y: + case _p_integer_y: + case _p_nonvar_y: + case _p_primitive_y: + case _p_var_y: + pc->u.yl.y = YAdjust(pc->u.yl.y); + pc->u.yl.F = PtoOpAdjust(pc->u.yl.F); + pc = NEXTOP(pc,yl); + break; + /* instructions type yx */ + case _get_y_val: + case _get_y_var: + case _put_unsafe: + case _put_y_val: + case _put_y_var: + pc->u.yx.y = YAdjust(pc->u.yx.y); + pc->u.yx.x = XAdjust(pc->u.yx.x); + pc = NEXTOP(pc,yx); + break; + /* instructions type yxc */ + case _p_and_y_vc: + case _p_arg_y_cv: + case _p_div_y_cv: + case _p_div_y_vc: + case _p_func2s_y_cv: + case _p_func2s_y_vc: + case _p_minus_y_cv: + case _p_or_y_vc: + case _p_plus_y_vc: + case _p_sll_y_cv: + case _p_sll_y_vc: + case _p_slr_y_cv: + case _p_slr_y_vc: + case _p_times_y_vc: + pc->u.yxc.xi = YAdjust(pc->u.yxc.xi); + pc->u.yxc.y = XAdjust(pc->u.yxc.y); + pc->u.yxc.c = ConstantTermAdjust(pc->u.yxc.c); + pc = NEXTOP(pc,yxc); + break; /* instructions type yxx */ - case _p_plus_y_vv: - case _p_minus_y_vv: - case _p_times_y_vv: - case _p_div_y_vv: case _p_and_y_vv: + case _p_arg_y_vv: + case _p_div_y_vv: + case _p_func2f_yx: + case _p_func2s_y_vv: + case _p_minus_y_vv: case _p_or_y_vv: + case _p_plus_y_vv: case _p_sll_y_vv: case _p_slr_y_vv: - case _p_arg_y_vv: - case _p_func2s_y_vv: - case _p_func2f_yx: - pc->u.yxx.y = YAdjust(pc->u.yxx.y); + case _p_times_y_vv: + pc->u.yxx.y = YAdjust(pc->u.yxx.y); pc->u.yxx.x1 = XAdjust(pc->u.yxx.x1); pc->u.yxx.x2 = XAdjust(pc->u.yxx.x2); pc = NEXTOP(pc,yxx); @@ -1139,61 +704,132 @@ restore_opcodes(yamop *pc) pc->u.yyx.x = XAdjust(pc->u.yyx.x); pc = NEXTOP(pc,yyx); break; - /* instructions type yxc */ - case _p_plus_y_vc: - case _p_minus_y_cv: - case _p_times_y_vc: - case _p_div_y_vc: - case _p_div_y_cv: - case _p_and_y_vc: - case _p_or_y_vc: - case _p_sll_y_vc: - case _p_slr_y_vc: - case _p_func2s_y_vc: - pc->u.yxc.y = YAdjust(pc->u.yxc.y); - pc->u.yxc.xi = XAdjust(pc->u.yxc.xi); - pc = NEXTOP(pc,yxc); +#ifdef YAPOR + /* instructions type apl */ + case _getwork: + case _getwork_seq: + case _sync: + pc->u.apl.s = ArityAdjust(pc->u.apl.s); + pc->u.apl.p = PtoPredAdjust(pc->u.apl.p); + pc->u.apl.d = PtoOpAdjust(pc->u.apl.d); + pc = NEXTOP(pc,apl); break; - /* instructions type yxc */ - case _p_sll_y_cv: - case _p_slr_y_cv: - case _p_arg_y_cv: - pc->u.yxc.y = YAdjust(pc->u.yxc.y); - pc->u.yxc.xi = XAdjust(pc->u.yxc.xi); - pc = NEXTOP(pc,yxc); + /* instructions type e */ + case _getwork_first_time: + if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return; + pc = NEXTOP(pc,e); break; - case _p_func2s_y_cv: - pc->u.yxc.y = YAdjust(pc->u.yxc.y); - if (IsAtomTerm(pc->u.yxc.c)) - pc->u.yxc.c = AtomTermAdjust(pc->u.yxc.c); - pc->u.yxc.xi = XAdjust(pc->u.yxc.xi); - pc = NEXTOP(pc,yxc); +#endif +#ifdef TABLING + /* instructions type apl */ + case _table_answer_resolution: + case _table_completion: + case _table_load_answer: + case _table_retry: + case _table_retry_me: + case _table_trust: + case _table_trust_me: + case _table_try: + case _table_try_answer: + case _table_try_me: + case _table_try_single: + pc->u.apl.s = ArityAdjust(pc->u.apl.s); + pc->u.apl.p = PtoPredAdjust(pc->u.apl.p); + pc->u.apl.d = PtoOpAdjust(pc->u.apl.d); + pc = NEXTOP(pc,apl); break; - /* instructions type plxxs */ - case _call_bfunc_xx: - pc->u.plxxs.p = PtoPredAdjust(pc->u.plxxs.p); - pc->u.plxxs.f = PtoOpAdjust(pc->u.plxxs.f); - pc->u.plxxs.x1 = XAdjust(pc->u.plxxs.x1); - pc->u.plxxs.x2 = XAdjust(pc->u.plxxs.x2); - pc = NEXTOP(pc,plxxs); + /* instructions type e */ +#ifdef TABLING_INNER_CUTS + case _clause_with_cut: +#endif + if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return; + pc = NEXTOP(pc,e); break; - /* instructions type plxys */ - case _call_bfunc_yx: - case _call_bfunc_xy: - pc->u.plxys.p = PtoPredAdjust(pc->u.plxys.p); - pc->u.plxys.f = PtoOpAdjust(pc->u.plxys.f); - pc->u.plxys.x = XAdjust(pc->u.plxys.x); - pc->u.plxys.y = YAdjust(pc->u.plxys.y); - pc = NEXTOP(pc,plxys); + /* instructions type s */ + case _table_new_answer: + pc->u.s.s = ConstantAdjust(pc->u.s.s); + pc = NEXTOP(pc,s); break; - case _call_bfunc_yy: - pc->u.plyys.p = PtoPredAdjust(pc->u.plyys.p); - pc->u.plyys.f = PtoOpAdjust(pc->u.plyys.f); - pc->u.plyys.y1 = YAdjust(pc->u.plyys.y1); - pc->u.plyys.y2 = YAdjust(pc->u.plyys.y2); - pc = NEXTOP(pc,plyys); + /* instructions type apl */ + case _table_answer_resolution: + case _table_completion: + case _table_load_answer: + case _table_retry: + case _table_retry_me: + case _table_trust: + case _table_trust_me: + case _table_try: + case _table_try_answer: + case _table_try_me: + case _table_try_single: + pc->u.apl.s = ArityAdjust(pc->u.apl.s); + pc->u.apl.p = PtoPredAdjust(pc->u.apl.p); + pc->u.apl.d = PtoOpAdjust(pc->u.apl.d); + pc = NEXTOP(pc,apl); break; + /* instructions type e */ +#ifdef TABLING_INNER_CUTS + case _clause_with_cut: +#endif + case _trie_do_atom: + case _trie_do_extension: + case _trie_do_float: + case _trie_do_list: + case _trie_do_long: + case _trie_do_null: + case _trie_do_struct: + case _trie_do_val: + case _trie_do_var: + case _trie_retry_atom: + case _trie_retry_extension: + case _trie_retry_float: + case _trie_retry_list: + case _trie_retry_long: + case _trie_retry_null: + case _trie_retry_struct: + case _trie_retry_val: + case _trie_retry_var: + case _trie_trust_atom: + case _trie_trust_extension: + case _trie_trust_float: + case _trie_trust_list: + case _trie_trust_long: + case _trie_trust_null: + case _trie_trust_struct: + case _trie_trust_val: + case _trie_trust_var: + case _trie_try_atom: + case _trie_try_extension: + case _trie_try_float: + case _trie_try_list: + case _trie_try_long: + case _trie_try_null: + case _trie_try_struct: + case _trie_try_val: + case _trie_try_var: + if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return; + pc = NEXTOP(pc,e); + break; + /* instructions type s */ + case _table_new_answer: + pc->u.s.s = ConstantAdjust(pc->u.s.s); + pc = NEXTOP(pc,s); + break; +#endif + /* this instruction is hardwired */ + case _or_last: +#ifdef YAPOR + pc->u.sblp.s = ConstantAdjust(pc->u.sblp.s); + pc->u.sblp.bmap = CellPtoHeapAdjust(pc->u.sblp.bmap); + pc->u.sblp.l = PtoOpAdjust(pc->u.sblp.l); + pc->u.sblp.p0 = PtoPredAdjust(pc->u.sblp.p0); + pc = NEXTOP(pc,sblp); + break; +#else + pc->u.p.p = PtoPredAdjust(pc->u.p.p); + pc = NEXTOP(pc,p); + break; +#endif } } while (TRUE); } - diff --git a/H/rheap.h b/H/rheap.h index 044645906..dff0822e9 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -239,6 +239,20 @@ static char SccsId[] = "@(#)rheap.c 1.3 3/15/90"; #define Atomics 0 #define Funcs 1 +static Term +ConstantTermAdjust (Term t) +{ + if (IsAtomTerm(t)) + return AtomTermAdjust(t); + else if (IsIntTerm(t)) + return t; + else if (IsApplTerm(t)) + return BlobTermAdjust(t); + else if (IsPairTerm(t)) + return CodeComposedTermAdjust(t); + else return t; +} + /* Now, everything on its place so you must adjust the pointers */ static void @@ -261,6 +275,108 @@ do_clean_susp_clauses(yamop *ipc) { } } +static void +AdjustSwitchTable(op_numbers op, yamop *table, COUNT i) +{ + CELL *startcode = (CELL *)table; + switch (op) { + case _switch_on_func: + { + COUNT j; + CELL *oldcode; + + oldcode = startcode; + for (j = 0; j < i; j++) { + Functor oldfunc = (Functor)(oldcode[0]); + CODEADDR oldjmp = (CODEADDR)(oldcode[1]); + if (oldfunc) { + oldcode[0] = (CELL)FuncAdjust(oldfunc); + } + oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); + oldcode += 2; + } + rehash(startcode, i, Funcs); + } + break; + case _switch_on_cons: + { + COUNT j; + CELL *oldcode; + +#if !defined(USE_OFFSETS) + oldcode = startcode; +#endif + for (j = 0; j < i; j++) { + Term oldcons = oldcode[0]; + CODEADDR oldjmp = (CODEADDR)(oldcode[1]); + if (oldcons != 0x0 && IsAtomTerm(oldcons)) { + oldcode[0] = AtomTermAdjust(oldcons); + } + oldcode[1] = (CELL)CodeAddrAdjust(oldjmp); + oldcode += 2; + } +#if !USE_OFFSETS + rehash(startcode, i, Atomics); +#endif + } + break; + case _go_on_func: + { + Functor oldfunc = (Functor)(startcode[0]); + + startcode[0] = (CELL)FuncAdjust(oldfunc); + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]); + } + break; + case _go_on_cons: + { + Term oldcons = startcode[0]; + + if (IsAtomTerm(oldcons)) { + startcode[0] = AtomTermAdjust(oldcons); + } + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]); + } + break; + case _if_func: + { + Int j; + + for (j = 0; j < i; j++) { + Functor oldfunc = (Functor)(startcode[0]); + CODEADDR oldjmp = (CODEADDR)(startcode[1]); + startcode[0] = (CELL)FuncAdjust(oldfunc); + startcode[1] = (CELL)CodeAddrAdjust(oldjmp); + startcode += 2; + } + /* adjust fail code */ + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + } + break; + case _if_cons: + { + Int j; + + for (j = 0; j < i; j++) { + Term oldcons = startcode[0]; + CODEADDR oldjmp = (CODEADDR)(startcode[1]); + if (IsAtomTerm(oldcons)) { + startcode[0] = (CELL)AtomTermAdjust(oldcons); + } + startcode[1] = (CELL)CodeAddrAdjust(oldjmp); + startcode += 2; + } + /* adjust fail code */ + startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]); + } + break; + default: + Yap_Error(INTERNAL_ERROR,0L,"Opcode Not Implemented in AdjustSwitchTable"); + } +} + #include "rclause.h" /* adjusts terms stored in the data base, when they have no variables */ @@ -1495,3 +1611,4 @@ RestoreAtom(AtomEntry *at) if (nat) at->NextOfAE = AbsAtom(AtomEntryAdjust(nat)); } + diff --git a/H/sshift.h b/H/sshift.h index 7738ebb05..88ea93bf7 100644 --- a/H/sshift.h +++ b/H/sshift.h @@ -152,7 +152,6 @@ DelayAdjust (CELL val) } - inline EXTERN ADDR GlobalAddrAdjust (ADDR); inline EXTERN ADDR @@ -167,6 +166,7 @@ GlobalAddrAdjust (ADDR ptr) + inline EXTERN ADDR DelayAddrAdjust (ADDR); inline EXTERN ADDR @@ -255,6 +255,8 @@ inline EXTERN CELL *CellPtoHeapAdjust (CELL *); inline EXTERN CELL * CellPtoHeapAdjust (CELL * ptr) { + if (!ptr) + return ptr; return (CELL *) (((CELL *) (CharP (ptr) + HDiff))); } @@ -319,6 +321,37 @@ PredEntryAdjust (PredEntry *p) return (PredEntry *) ((p == NULL ? (p) : (PredEntry *) (CharP (p) + HDiff))); } +inline EXTERN COUNT ConstantAdjust (COUNT); + +inline EXTERN COUNT +ConstantAdjust (COUNT val) +{ + return val; +} + +inline EXTERN Int ArityAdjust (Int); + +inline EXTERN Int +ArityAdjust (Int val) +{ + return val; +} + +inline EXTERN OPCODE OpcodeAdjust (OPCODE); + +inline EXTERN OPCODE +OpcodeAdjust (OPCODE val) +{ + return Yap_opcode(Yap_op_from_opcode(val)); +} + +#define DoubleInCodeAdjust(D) + +#define IntegerInCodeAdjust(D) + +#define IntegerAdjust(D) (D) + +#define ExternalFunctionAdjust(D) (D); inline EXTERN Term AtomTermAdjust (Term); @@ -328,6 +361,14 @@ AtomTermAdjust (Term at) return at + HDiff; } +inline EXTERN Term ModuleAdjust (Term); + +inline EXTERN Term +ModuleAdjust (Term t) +{ + return AtomTermAdjust(t); +} + inline EXTERN Term CodeVarAdjust (Term); inline EXTERN Term @@ -656,7 +697,6 @@ YAdjust (yslot reg) - inline EXTERN int IsOldLocal (CELL); inline EXTERN int diff --git a/misc/buildops b/misc/buildops index 94d2c725d..60cbf9927 100644 --- a/misc/buildops +++ b/misc/buildops @@ -124,9 +124,19 @@ output_type(T, C) :- output_typeinfo(C,T) :- tinfo(T, Info), dump_fields(C,Info,T,T), + special_formats(C,T), format(C,' pc = NEXTOP(pc,~s); break;~n',[T]). +% tables require access to the table info. +special_formats(C,"e") :- !, + format(C,' if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return;~n',[]). +special_formats(C,"l") :- !, + format(C,' if (op == _Ystop) return;~n',[]). +special_formats(C,"sssl") :- !, + format(C,' AdjustSwitchTable(op, pc->u.sssl.l, pc->u.sssl.s);~n',[]). +special_formats(_,_). + dump_fields(_,[],"e",_). dump_fields(_,[],[],_). dump_fields(C,[I-"none"|Info],[O|Ops],T) :- !, @@ -136,25 +146,32 @@ dump_fields(C,[_|Info],Ops,T) :- dump_fields(C,Info,Ops,T). dump_field(C,I,O,T) :- + O \= 0'd, + O \= 0'i, !, get_op(O,A), - format(C," pc->u.~s.~s = ~sAdjust(pc->u.~s.~s);~n",[T,I,A,T,I]). + format(C,' pc->u.~s.~s = ~sAdjust(pc->u.~s.~s);~n',[T,I,A,T,I]). +dump_field(C,I,O,T) :- + get_op(O,A), + format(C,' ~sAdjust(pc->u.~s.~s);~n',[A,T,I]). get_op(0'a,"Arity"). get_op(0'b,"CellPtoHeap"). get_op(0'c,"ConstantTerm"). get_op(0'd,"DoubleInCode"). -get_op(0'f,"Functor"). +get_op(0'f,"Func"). get_op(0'F,"ExternalFunction"). get_op(0'i,"IntegerInCode"). -get_op(0'I,"LogUpdIndex"). +get_op(0'I,"PtoLUIndex"). get_op(0'l,"PtoOp"). -get_op(0'L,"LogUpdClause"). +get_op(0'L,"PtoLUClause"). get_op(0'm,"Module"). +get_op(0'n,"Integer"). get_op(0'o,"Opcode"). get_op(0'p,"PtoPred"). get_op(0's,"Constant"). get_op(0'x,"X"). get_op(0'y,"Y"). +% ' dump_ops(_,[]). dump_ops(C,[Op|Ops]) :- @@ -162,7 +179,7 @@ dump_ops(C,[Op|Ops]) :- format(C,' case _~s:~n',[Op]), end_special(Op,C), dump_ops(C,Ops). - + /* or_last requires special handling */ footer(W) :- format(W,' /* this instruction is hardwired */~n',[]),