diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more fixes to make rclause.h automatic:

Browse Source 
define new type n for Integers, as they were mistaken for Term.
 define early return cases and ifdef exceptions.
This commit is contained in:
Vitor Santos Costa 2008-08-29 17:27:11 +01:00
parent 6063c019de
commit d636450512
12 changed files with 1069 additions and 1223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
C/absmi.c
View File

@ -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);

10
C/agc.c
View File

@ -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)

16
C/amasm.c
View File

@ -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;
}
}

40
C/cdmgr.c
View File

@ -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;

20
C/index.c
View File

@ -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) &&

3
C/tracer.c
View File

@ -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

32
H/YapOpcodes.h
View File

@ -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),

7
H/amidefs.h
View File

@ -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;

1796
H/rclause.h
View File

File diff suppressed because it is too large Load Diff

117
H/rheap.h
View File

@ -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));
}

44
H/sshift.h
View File

@ -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

27
misc/buildops
View File

@ -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',[]),