/*-------------------------------------------------------------------------* * PL_CURRENT_PREDICATE_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Predicate_Alt_0(void) { WamWord name_word, arity_word; HashScan scan; PredInf *pred; int which_preds; int func, arity; int func1, arity1; Bool all; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PREDICATE_ALT, 0), 0); name_word = AB(B, 0); arity_word = AB(B, 1); which_preds = AB(B, 2); scan.endt = (char *) AB(B, 3); scan.cur_t = (char *) AB(B, 4); scan.cur_p = (char *) AB(B, 5); func = Tag_Mask_Of(name_word) == TAG_REF_MASK ? -1 : UnTag_ATM(name_word); arity = Tag_Mask_Of(arity_word) == TAG_REF_MASK ? -1 : UnTag_INT(arity_word); /* here func or arity == -1 (or both) */ all = (func == -1 && arity == -1); for (;;) { pred = (PredInf *) Pl_Hash_Next(&scan); if (pred == NULL) { Delete_Last_Choice_Point(); return FALSE; } func1 = Functor_Of(pred->f_n); arity1 = Arity_Of(pred->f_n); if ((all || func == func1 || arity == arity1) && Pred_Is_Ok(pred, func1, which_preds)) break; } /* non deterministic case */ #if 0 /* the following data is unchanged */ AB(B, 0) = name_word; AB(B, 1) = arity_word; AB(B, 2) = which_preds; AB(B, 3) = (WamWord) scan.endt; #endif AB(B, 4) = (WamWord) scan.cur_t; AB(B, 5) = (WamWord) scan.cur_p; return Pl_Get_Atom(Functor_Of(pred->f_n), name_word) && Pl_Get_Integer(Arity_Of(pred->f_n), arity_word); }
/*-------------------------------------------------------------------------* * PL_TERM_REF_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Ref_2(WamWord term_word, WamWord ref_word) { WamWord word, tag_mask; WamWord word1, *adr; int ref; /* my own DEREF here to get the address */ adr = NULL; /* added this */ word = term_word; do { word1 = word; tag_mask = Tag_Mask_Of(word); if (tag_mask != TAG_REF_MASK) break; adr = UnTag_REF(word); /* added this */ word = *adr; } while (word != word1); if (tag_mask == TAG_REF_MASK) { ref = Pl_Rd_Positive_Check(ref_word); adr = Global_Stack + ref; return Pl_Unify(word, *adr); } if (adr < Global_Stack || adr > H) { adr = H; Global_Push(word); } ref = Global_Offset(adr); return Pl_Un_Positive_Check(ref, ref_word); }
/*-------------------------------------------------------------------------* * NORMALIZE * * * * This functions normalizes a term. * * Input: * * e_word: term to normalize * * sign : current sign of the term (-1 or +1) * * * * Output: * * p : the associated polynomial term * * * * Normalizes the term and loads it into p. * * Non-Linear operations are simplified and loaded into a stack to be * * executed later. * * * * T1*T2 : T1 and T2 are normalized to give the polynomials p1 and p2, with* * p1 = c1 + a1X1 + a2X2 + ... + anXn * * p2 = c2 + b1X1 + b2X2 + ... + bmXm * * and replaced by c1*c2 + * * a1X1 * c2 + a1X1 * b1X1 + ... + a1X1 * bmXm * * ... * * anX1 * c2 + anXn * b1X1 + ... + anXn * bmXm * * * * T1**T2: T1 and T2 are loaded into 2 new words word1 and word2 that can * * be integers or variables (tagged words). The code emitted * * depends on 3 possibilities (var**var is not allowed) * * (+ optim 1**T2, 0**T2, T1**0, T1**1), NB 0**0=1 * *-------------------------------------------------------------------------*/ static Bool Normalize(WamWord e_word, int sign, Poly *p) { WamWord word, tag_mask; WamWord *adr; WamWord *fdv_adr; WamWord word1, word2, word3; WamWord f_n, le_word, re_word; int i; PlLong n1, n2, n3; terminal_rec: DEREF(e_word, word, tag_mask); if (tag_mask == TAG_FDV_MASK) { fdv_adr = UnTag_FDV(word); Add_Monom(p, sign, 1, Tag_REF(fdv_adr)); return TRUE; } if (tag_mask == TAG_INT_MASK) { n1 = UnTag_INT(word); if (n1 > MAX_COEF_FOR_SORT) sort = TRUE; Add_Cst_To_Poly(p, sign, n1); return TRUE; } if (tag_mask == TAG_REF_MASK) { if (vars_sp - vars_tbl >= VARS_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); *vars_sp++ = word; Add_Monom(p, sign, 1, word); return TRUE; } if (tag_mask == TAG_ATM_MASK) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(e_word); Pl_Unify_Integer(0); type_error: Pl_Err_Type(pl_type_fd_evaluable, word); } if (tag_mask != TAG_STC_MASK) goto type_error; adr = UnTag_STC(word); f_n = Functor_And_Arity(adr); for (i = 0; i < NB_OF_OP; i++) if (arith_tbl[i] == f_n) break; le_word = Arg(adr, 0); re_word = Arg(adr, 1); switch (i) { case PLUS_1: e_word = le_word; goto terminal_rec; case PLUS_2: if (!Normalize(le_word, sign, p)) return FALSE; e_word = re_word; goto terminal_rec; case MINUS_2: if (!Normalize(le_word, sign, p)) return FALSE; e_word = re_word; sign = -sign; goto terminal_rec; case MINUS_1: e_word = le_word; sign = -sign; goto terminal_rec; case TIMES_2: #ifdef DEVELOP_TIMES_2 #if 1 /* optimize frequent use: INT*VAR */ DEREF(le_word, word, tag_mask); if (tag_mask != TAG_INT_MASK) goto any; n1 = UnTag_INT(word); if (n1 > MAX_COEF_FOR_SORT) sort = TRUE; DEREF(re_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { if (tag_mask != TAG_FDV_MASK) goto any; else { fdv_adr = UnTag_FDV(word); word = Tag_REF(fdv_adr); } } Add_Monom(p, sign, n1, word); return TRUE; any: #endif { Poly p1, p2; int i1, i2; New_Poly(p1); New_Poly(p2); if (!Normalize(le_word, 1, &p1) || !Normalize(re_word, 1, &p2)) return FALSE; Add_Cst_To_Poly(p, sign, p1.c * p2.c); for (i1 = 0; i1 < p1.nb_monom; i1++) { Add_Monom(p, sign, p1.m[i1].a * p2.c, p1.m[i1].x_word); for (i2 = 0; i2 < p2.nb_monom; i2++) if (!Add_Multiply_Monom(p, sign, p1.m + i1, p2.m + i2)) return FALSE; } for (i2 = 0; i2 < p2.nb_monom; i2++) Add_Monom(p, sign, p2.m[i2].a * p1.c, p2.m[i2].x_word); return TRUE; } #else if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = n1 * n2; Add_Cst_To_Poly(p, sign, n1); return TRUE; } Add_Monom(p, sign, n1, word2); return TRUE; } if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); Add_Monom(p, sign, n2, word1); return TRUE; } word1 = (word1 == word2) ? Push_Delayed_Cstr(DC_X2_EQ_Y, word1, 0, 0) : Push_Delayed_Cstr(DC_XY_EQ_Z, word1, word2, 0); Add_Monom(p, sign, 1, word1); return TRUE; #endif case POWER_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if ((n1 = Pl_Power(n1, n2)) < 0) return FALSE; Add_Cst_To_Poly(p, sign, n1); return TRUE; } if (n1 == 1) { Add_Cst_To_Poly(p, sign, 1); return TRUE; } word = (n1 == 0) ? Push_Delayed_Cstr(DC_ZERO_POWER_N_EQ_Y, word2, 0, 0) : Push_Delayed_Cstr(DC_A_POWER_N_EQ_Y, word1, word2, 0); goto end_power; } if (Tag_Mask_Of(word2) != TAG_INT_MASK) Pl_Err_Instantiation(); else { n2 = UnTag_INT(word2); if (n2 == 0) { Add_Cst_To_Poly(p, sign, 1); return TRUE; } word = (n2 == 1) ? word1 : (n2 == 2) ? Push_Delayed_Cstr(DC_X2_EQ_Y, word1, 0, 0) : Push_Delayed_Cstr(DC_X_POWER_A_EQ_Y, word1, word2, 0); } end_power: Add_Monom(p, sign, 1, word); return TRUE; case MIN_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = math_min(n1, n2); Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_MIN_X_A_EQ_Z, word2, word1, 0); goto end_min; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_MIN_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_MIN_X_Y_EQ_Z, word1, word2, 0); end_min: Add_Monom(p, sign, 1, word); return TRUE; case MAX_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = math_max(n1, n2); Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_MAX_X_A_EQ_Z, word2, word1, 0); goto end_max; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_MAX_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_MAX_X_Y_EQ_Z, word1, word2, 0); end_max: Add_Monom(p, sign, 1, word); return TRUE; case DIST_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = (n1 >= n2) ? n1 - n2 : n2 - n1; Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_ABS_X_MINUS_A_EQ_Z, word2, word1, 0); goto end_dist; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_ABS_X_MINUS_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_ABS_X_MINUS_Y_EQ_Z, word1, word2, 0); end_dist: Add_Monom(p, sign, 1, word); return TRUE; case QUOT_2: word3 = Make_Self_Ref(H); /* word3 = remainder */ Global_Push(word3); goto quot_rem; case REM_2: word3 = Make_Self_Ref(H); /* word3 = remainder */ Global_Push(word3); goto quot_rem; case QUOT_REM_3: quot_rem: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2) || (i == QUOT_REM_3 && !Load_Term_Into_Word(Arg(adr, 2), &word3))) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0) return FALSE; n3 = n1 % n2; if (i == QUOT_2 || i == QUOT_REM_3) { if (i == QUOT_REM_3) PRIM_CSTR_2(pl_x_eq_c, word3, word); else H--; /* recover word3 space */ n3 = n1 / n2; } Add_Cst_To_Poly(p, sign, n3); return TRUE; } word = Push_Delayed_Cstr(DC_QUOT_REM_A_Y_R_EQ_Z, word1, word2, word3); goto end_quot_rem; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_QUOT_REM_X_A_R_EQ_Z, word1, word2, word3); else word = Push_Delayed_Cstr(DC_QUOT_REM_X_Y_R_EQ_Z, word1, word2, word3); end_quot_rem: Add_Monom(p, sign, 1, (i == REM_2) ? word3 : word); return TRUE; case DIV_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0 || n1 % n2 != 0) return FALSE; n1 /= n2; Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_DIV_A_Y_EQ_Z, word1, word2, 0); goto end_div; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_DIV_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_DIV_X_Y_EQ_Z, word1, word2, 0); end_div: Add_Monom(p, sign, 1, word); return TRUE; default: word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); goto type_error; } return TRUE; }