/*-------------------------------------------------------------------------*
* PL_SUB_ATOM_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Sub_Atom_Alt_0(void)
{
WamWord before_word, length_word, after_word, sub_atom_word;
AtomInf *patom;
AtomInf *psub_atom;
int b, l, a;
int b1, l1, a1;
int mask;
char *str;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 0);
before_word = AB(B, 0);
length_word = AB(B, 1);
after_word = AB(B, 2);
sub_atom_word = AB(B, 3);
patom = (AtomInf *) AB(B, 4);
psub_atom = (AtomInf *) AB(B, 5);
mask = AB(B, 6);
b = AB(B, 7);
l = AB(B, 8);
a = AB(B, 9);
if (!Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1))
Delete_Last_Choice_Point();
else /* non deterministic case */
{
#if 0 /* the following data is unchanged */
AB(B, 0) = before_word;
AB(B, 1) = length_word;
AB(B, 2) = after_word;
AB(B, 3) = sub_atom_word;
AB(B, 4) = (WamWord) patom;
AB(B, 5) = (WamWord) psub_atom;
AB(B, 6) = mask;
#endif
AB(B, 7) = b1;
AB(B, 8) = l1;
AB(B, 9) = a1;
}
if (mask <= 7)
{
MALLOC_STR(l);
strncpy(str, patom->name + b, l);
str[l] = '\0';
Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word);
Pl_Get_Integer(l, length_word);
}
return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word);
}
/*-------------------------------------------------------------------------*
* SET_VAR *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Var(WamWord *exp, int result, WamWord *load_word)
{
if (result == 0) /* X is false */
return Pl_Get_Integer(0, *exp);
if (result == 1) /* X is true */
return Pl_Get_Integer(1, *exp);
*load_word = *exp; /* X = B */
return TRUE;
}
/*-------------------------------------------------------------------------*
* SET_NOT *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Not(WamWord *exp, int result, WamWord *load_word)
{
if (result == 0) /* ~X is false */
return Pl_Get_Integer(1, exp[1]);
if (result == 1) /* ~X is true */
return Pl_Get_Integer(0, exp[1]);
/* ~X=B */
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
BOOL_CSTR_2(pl_not_x_eq_b, exp[1], *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_MIRROR_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Mirror_Alt_0(void)
{
/* int stm; */
WamWord m_stm_word;
StmLst *m;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MIRROR_ALT, 0), 0);
/* stm = AB(B, 0); */
m_stm_word = AB(B, 1);
m = (StmLst *) AB(B, 2);
if (m->next) /* non deterministic case */
{
#if 0 /* the following data is unchanged */
AB(B, 0) = stm;
AB(B, 1) = m_stm_word;
#endif
AB(B, 2) = (WamWord) m->next;
}
else
Delete_Last_Choice_Point();
return Pl_Get_Integer(m->stm, m_stm_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_STREAM_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Stream_1(WamWord stm_word)
{
WamWord word, tag_mask;
int stm = 0;
DEREF(stm_word, word, tag_mask); /* either an INT or a REF */
if (tag_mask == TAG_INT_MASK)
{
stm = UnTag_INT(word);
return (stm >= 0 && stm <= pl_stm_last_used && pl_stm_tbl[stm] != NULL);
}
for (; stm <= pl_stm_last_used; stm++)
if (pl_stm_tbl[stm])
break;
if (stm >= pl_stm_last_used)
{
if (stm > pl_stm_last_used)
return FALSE;
}
else /* non deterministic case */
{
A(0) = stm_word;
A(1) = stm + 1;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_STREAM_ALT, 0),
2);
}
return Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_STREAM_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Stream_Alt_0(void)
{
WamWord stm_word;
int stm;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_STREAM_ALT, 0), 0);
stm_word = AB(B, 0);
stm = AB(B, 1);
for (; stm <= pl_stm_last_used; stm++)
if (pl_stm_tbl[stm])
break;
if (stm >= pl_stm_last_used)
{
Delete_Last_Choice_Point();
if (stm > pl_stm_last_used)
return FALSE;
}
else /* non deterministic case */
{
#if 0 /* the following data is unchanged */
AB(B, 0) = stm_word;
#endif
AB(B, 1) = stm + 1;
}
return Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_SR_INIT_OPEN_2 *
* *
*-------------------------------------------------------------------------*/
void
Pl_SR_Init_Open_2(WamWord desc_word, WamWord out_sora_word)
{
SRInf *sr;
int desc;
if (sr_tbl == NULL) /* first allocation */
{
sr_tbl_size = 8;
sr_last_used = -1;
sr_tbl = (SRInf *) Calloc(sr_tbl_size, sizeof(SRInf));
}
for(desc = 0; desc < sr_tbl_size; desc++)
if (!sr_tbl[desc].in_use)
break;
if (desc == sr_tbl_size)
Pl_Extend_Array((char **) &sr_tbl, &sr_tbl_size, sizeof(SRInf), TRUE);
if (desc > sr_last_used)
sr_last_used = desc;
sr = cur_sr = sr_tbl + desc;
if (sr->file_top) /* to due a previous aborted sr_open/3 */
{
Free(sr->file_top);
sr->file_top = NULL;
}
sr->mask = SYS_VAR_OPTION_MASK;
sr->file_first = NULL;
sr->file_last = NULL;
sr->next_to_reread = NULL; /* 1st read mode */
sr->cur_l1 = sr->cur_l2 = 0;
sr->char_count = 0;
sr->line_count = 0;
sr->error_count = 0;
sr->warning_count = 0;
if (pl_sys_var[1])
{
Pl_Get_Stream_Or_Alias(out_sora_word, STREAM_CHECK_VALID);
sr->out_sora_word = out_sora_word;
}
else
sr->out_sora_word = NOT_A_WAM_WORD;
sr->direct_lst.first = NULL;
sr->direct_lst.last = NULL;
sr->module_lst = NULL;
sr->cur_module = NULL;
sr->interface = FALSE;
Pl_Get_Integer(desc, desc_word);
}
/*-------------------------------------------------------------------------*
* PL_BETWEEN_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Between_3(WamWord l_word, WamWord u_word, WamWord i_word)
{
WamWord word, tag_mask;
PlLong l, u, i;
l = Pl_Rd_Integer_Check(l_word);
u = Pl_Rd_Integer_Check(u_word);
DEREF(i_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
{
i = Pl_Rd_Integer_Check(word);
return i >= l && i <= u;
}
i_word = word;
if (l > u)
return FALSE;
/* here i_word is a variable */
if (l < u) /* non deterministic case */
{
A(0) = l + 1;
A(1) = u;
A(2) = i_word;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(BETWEEN_ALT, 0), 3);
}
return Pl_Get_Integer(l, i_word); /* always TRUE */
}
/*-------------------------------------------------------------------------*
* PL_BETWEEN_ALT_0 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Between_Alt_0(void)
{
PlLong l, u;
WamWord i_word;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(BETWEEN_ALT, 0), 0);
l = AB(B, 0);
u = AB(B, 1);
i_word = AB(B, 2);
/* here i_word is a variable */
if (l == u)
Delete_Last_Choice_Point();
else /* non deterministic case */
{
AB(B, 0) = l + 1;
#if 0 /* the following data is unchanged */
AB(B, 1) = u;
AB(B, 2) = i_word;
#endif
}
Pl_Get_Integer(l, i_word); /* always TRUE */
}
/*-------------------------------------------------------------------------*
* PL_STREAM_POSITION_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Position_2(WamWord sora_word, WamWord position_word)
{
WamWord word, tag_mask;
WamWord p_word[4];
PlLong p[4];
int i;
int stm;
StmInf *pstm;
stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST);
pstm = pl_stm_tbl[stm];
Pl_Stream_Get_Position(pstm, p, p + 1, p + 2, p + 3);
if (!Pl_Get_Structure(pl_atom_stream_position, 4, position_word))
dom_error:
Pl_Err_Domain(pl_domain_stream_position, position_word);
for (i = 0; i < 4; i++)
{
p_word[i] = Pl_Unify_Variable();
DEREF(p_word[i], word, tag_mask);
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK)
goto dom_error;
}
for (i = 0; i < 4; i++)
if (!Pl_Get_Integer(p[i], p_word[i]))
return FALSE;
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_OPEN_INPUT_TERM_STREAM_2 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Open_Input_Term_Stream_2(WamWord sink_term_word, WamWord stm_word)
{
char *str;
int stm;
int n;
if (SYS_VAR_OPTION_MASK == TERM_STREAM_ATOM)
str = pl_atom_tbl[Pl_Rd_Atom_Check(sink_term_word)].name;
else
{
n = Pl_List_Length(sink_term_word); /* -1 if not a list */
if (n >= 0)
str = Malloc(n + 1); /* +1 for \0 */
else
str = pl_glob_buff;
if (SYS_VAR_OPTION_MASK == TERM_STREAM_CHARS)
Pl_Rd_Chars_Str_Check(sink_term_word, str);
else
Pl_Rd_Codes_Str_Check(sink_term_word, str);
}
stm = Pl_Add_Str_Stream(str, SYS_VAR_OPTION_MASK);
Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* 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_FROM_ALIAS_TO_STREAM_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_From_Alias_To_Stream_2(WamWord alias_word, WamWord stm_word)
{
int stm;
stm = Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(alias_word));
return stm >= 0 && Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_OPEN_OUTPUT_TERM_STREAM_1 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Open_Output_Term_Stream_1(WamWord stm_word)
{
int stm;
stm = Pl_Add_Str_Stream(NULL, SYS_VAR_OPTION_MASK);
Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_GET_PRINT_STM_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Get_Print_Stm_1(WamWord stm_word)
{
int stm = Pl_Find_Stream_From_PStm(pstm_o);
if (stm < 0)
stm = pl_stm_output;
return Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_GET_PRED_INDIC_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Get_Pred_Indic_3(WamWord pred_indic_word, WamWord func_word,
WamWord arity_word)
{
int func, arity;
func = Pl_Get_Pred_Indicator(pred_indic_word, TRUE, &arity);
return Pl_Get_Atom(func, func_word) && Pl_Get_Integer(arity, arity_word);
}
/*-------------------------------------------------------------------------*
* PL_ATOM_PROPERTY_6 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Atom_Property_6(WamWord atom_word,
WamWord prefix_op_word, WamWord infix_op_word,
WamWord postfix_op_word,
WamWord needs_quote_word, WamWord needs_scan_word)
{
WamWord word, tag_mask;
int atom;
DEREF(atom_word, word, tag_mask);
atom = UnTag_ATM(word);
Pl_Get_Integer(Check_Oper(atom, PREFIX) != 0, prefix_op_word);
Pl_Get_Integer(Check_Oper(atom, INFIX) != 0, infix_op_word);
Pl_Get_Integer(Check_Oper(atom, POSTFIX) != 0, postfix_op_word);
Pl_Get_Integer(pl_atom_tbl[atom].prop.needs_quote, needs_quote_word);
Pl_Get_Integer(pl_atom_tbl[atom].prop.needs_scan, needs_scan_word);
}
/*-------------------------------------------------------------------------*
* SET_ONE *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_One(WamWord *exp, int result, WamWord *load_word)
{
if (result == 0) /* 1 is false */
return FALSE;
if (result == 1) /* 1 is true */
return TRUE;
/* 1 = B */
return Pl_Get_Integer(1, *load_word);
}
/*-------------------------------------------------------------------------*
* PL_SEEK_4 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Seek_4(WamWord sora_word, WamWord whence_word, WamWord offset_word,
WamWord new_loc_word)
{
int stm;
StmInf *pstm;
int whence;
PlLong offset;
int atom;
PlLong p[4];
stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST);
pstm = pl_stm_tbl[stm];
if (!pstm->prop.reposition)
Pl_Err_Permission(pl_permission_operation_reposition,
pl_permission_type_stream, sora_word);
if (pstm->prop.text)
Pl_Err_Permission(pl_permission_operation_reposition,
pl_permission_type_text_stream, sora_word);
atom = Pl_Rd_Atom_Check(whence_word);
if (atom == pl_atom_bof)
whence = SEEK_SET;
else if (atom == pl_atom_current)
whence = SEEK_CUR;
else if (atom == pl_atom_eof)
whence = SEEK_END;
else
Pl_Err_Domain(pl_domain_stream_seek_method, whence_word);
offset = Pl_Rd_Integer_Check(offset_word);
Pl_Check_For_Un_Integer(new_loc_word);
if (Pl_Stream_Set_Position(pstm, whence, offset, offset, 0, 0) != 0)
return FALSE;
Pl_Stream_Get_Position(pstm, &offset, p + 1, p + 2, p + 3);
return Pl_Get_Integer(offset, new_loc_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_MIRROR_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Mirror_2(WamWord stm_word, WamWord m_stm_word)
{
int stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
StmInf *pstm = pl_stm_tbl[stm];
StmLst *m = pstm->mirror;
/* From here, the code also works with */
/* m = m_pstm->mirror_of. Could be used */
/* if m_stm_word is given and not stm_word */
if (m == NULL)
return FALSE;
if (m->next != NULL) /* non deterministic case */
{
A(0) = stm; /* useless in fact */
A(1) = m_stm_word;
A(2) = (WamWord) m->next;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MIRROR_ALT, 0), 3);
}
return Pl_Get_Integer(m->stm, m_stm_word);
}
/*-------------------------------------------------------------------------*
* PL_FD_REIFIED_IN *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word)
{
WamWord word, tag_mask;
WamWord b_tag_mask, x_tag_mask;
WamWord *adr, *fdv_adr;
int x;
int l = Pl_Rd_Integer_Check(l_word);
int u = Pl_Rd_Integer_Check(u_word);
int b = -1; /* a var */
Range *r;
int x_min, x_max;
Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word);
Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word);
DEREF(x_word, word, tag_mask);
x_word = word;
x_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
{
err_type_fd:
Pl_Err_Type(pl_type_fd_variable, word);
return FALSE;
}
DEREF(b_word, word, tag_mask);
b_word = word;
b_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
goto err_type_fd;
if (x_tag_mask == TAG_INT_MASK)
{
x = UnTag_INT(x_word);
b = (x >= l) && (x <= u);
unif_b:
return Pl_Get_Integer(b, b_word);
}
if (b_tag_mask == TAG_INT_MASK)
{
b = UnTag_INT(b_word);
if (b == 0)
return pl_fd_not_domain(x_word, l_word, u_word);
return (b == 1) && pl_fd_domain(x_word, l_word, u_word);
}
if (x_tag_mask == TAG_REF_MASK) /* make an FD var */
{
adr = UnTag_REF(x_word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
else
fdv_adr = UnTag_FDV(x_word);
r = Range(fdv_adr);
x_min = r->min;
x_max = r->max;
if (x_min >= l && x_max <= u)
{
b = 1;
goto unif_b;
}
if (l > u || x_max < l || x_min > u) /* NB: if L..U is empty then B = 0 */
{
b = 0;
goto unif_b;
}
if (!Pl_Fd_Check_For_Bool_Var(b_word))
return FALSE;
PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_STOP_MARK_1 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Stop_Mark_1(WamWord stop_word)
{
Pl_Get_Integer(sol->sol_no, stop_word);
}
/*-------------------------------------------------------------------------*
* SET_LTE *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Lte(WamWord *exp, int result, WamWord *load_word)
{
WamWord le_word, re_word;
int mask;
WamWord l_word, r_word;
PlLong c;
le_word = exp[1];
re_word = exp[2];
if (result == 0) /* L <= R is false */
return Pl_Fd_Lt_2(re_word, le_word);
if (result == 1) /* L <= R is true */
return Pl_Fd_Lte_2(le_word, re_word);
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
#ifdef DEBUG
cur_op = (pl_full_ac) ? "truth#=<#" : "truth#=<";
#endif
if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word)
|| !Pl_Term_Math_Loading(l_word, r_word))
return FALSE;
switch (mask)
{
case MASK_EMPTY:
return Pl_Get_Integer(c <= 0, *load_word);
case MASK_LEFT:
if (c > 0)
return Pl_Get_Integer(0, *load_word);
PRIM_CSTR_3(pl_truth_x_lte_c, l_word, Tag_INT(-c), *load_word);
return TRUE;
case MASK_RIGHT:
if (c <= 0)
return Pl_Get_Integer(1, *load_word);
PRIM_CSTR_3(pl_truth_x_gte_c, r_word, Tag_INT(c), *load_word);
return TRUE;
}
if (c > 0)
{
PRIM_CSTR_4(pl_truth_x_plus_c_lte_y, l_word, Tag_INT(c), r_word,
*load_word);
return TRUE;
}
if (c < 0)
{
PRIM_CSTR_4(pl_truth_x_plus_c_gte_y, r_word, Tag_INT(-c), l_word,
*load_word);
return TRUE;
}
PRIM_CSTR_3(pl_truth_x_lte_y, l_word, r_word, *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_SUB_ATOM_5 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Sub_Atom_5(WamWord atom_word, WamWord before_word, WamWord length_word,
WamWord after_word, WamWord sub_atom_word)
{
WamWord word, tag_mask;
AtomInf *patom;
AtomInf *psub_atom = NULL; /* only for the compiler */
int length;
PlLong b, l, a;
int b1, l1, a1;
Bool nondet;
int mask = 0;
char *str;
patom = pl_atom_tbl + Pl_Rd_Atom_Check(atom_word);
length = patom->prop.length;
DEREF_LG(before_word, b);
DEREF_LG(length_word, l);
DEREF_LG(after_word, a);
DEREF(sub_atom_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
Pl_Err_Type(pl_type_atom, word);
sub_atom_word = word;
if (tag_mask == TAG_ATM_MASK)
{
psub_atom = pl_atom_tbl + UnTag_ATM(word);
l = psub_atom->prop.length;
if (!Pl_Get_Integer(l, length_word))
return FALSE;
if ((mask & 5) == 5 && length != b + l + a) /* B and A fixed */
return FALSE;
if (mask & 4) /* B fixed */
{
a = length - b - l;
return strncmp(patom->name + b, psub_atom->name, l) == 0 &&
Pl_Get_Integer(a, after_word);
}
if (mask & 1) /* A fixed */
{
b = length - l - a;
return strncmp(patom->name + b, psub_atom->name, l) == 0 &&
Pl_Get_Integer(b, before_word);
}
mask = 8; /* set sub_atom as fixed */
}
switch (mask) /* mask <= 7, B L A (1: fixed, 0: var) */
{
case 0: /* nothing fixed */
case 2: /* L fixed */
case 4: /* B fixed */
a = length - b - l;
nondet = TRUE;
break;
case 1: /* A fixed */
l = length - b - a;
nondet = TRUE;
break;
case 3: /* L A fixed */
b = length - l - a;
nondet = FALSE;
break;
case 5: /* B A fixed */
l = length - b - a;
nondet = FALSE;
break;
case 6: /* B L fixed */
case 7: /* B L A fixed */
a = length - b - l;
nondet = FALSE;
break;
default: /* sub_atom fixed */
if ((str = strstr(patom->name + b, psub_atom->name)) == NULL)
return FALSE;
b = str - patom->name;
a = length - b - l;
nondet = TRUE;
break;
}
if (b < 0 || l < 0 || a < 0)
return FALSE;
if (nondet
&& Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1))
{ /* non deterministic case */
A(0) = before_word;
A(1) = length_word;
A(2) = after_word;
A(3) = sub_atom_word;
A(4) = (WamWord) patom;
A(5) = (WamWord) psub_atom;
A(6) = mask;
A(7) = b1;
A(8) = l1;
A(9) = a1;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 10);
}
if (mask <= 7)
{
MALLOC_STR(l);
strncpy(str, patom->name + b, l);
str[l] = '\0';
Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word);
Pl_Get_Integer(l, length_word);
}
return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word);
}
/*-------------------------------------------------------------------------*
* PL_FD_REIFIED_IN *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word)
{
WamWord word, tag_mask;
WamWord b_tag_mask, x_tag_mask;
WamWord *adr, *fdv_adr;
PlLong x;
PlLong b = -1; /* a var */
int min, max;
int x_min, x_max;
Range *r;
// Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word);
/* from fd_values_c.c (optimized version) */
Bool Pl_Fd_Domain_Interval(WamWord x_word, int min, int max);
/* from fd_values_fd.fd */
Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word);
min = Pl_Fd_Prolog_To_Value(l_word);
if (min < 0)
min = 0;
max = Pl_Fd_Prolog_To_Value(u_word);
DEREF(x_word, word, tag_mask);
x_word = word;
x_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
{
err_type_fd:
Pl_Err_Type(pl_type_fd_variable, word);
return FALSE;
}
DEREF(b_word, word, tag_mask);
b_word = word;
b_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
goto err_type_fd;
if (x_tag_mask == TAG_INT_MASK)
{
x = UnTag_INT(x_word);
b = (x >= min) && (x <= max);
unif_b:
return Pl_Get_Integer(b, b_word);
}
if (b_tag_mask == TAG_INT_MASK)
{
b = UnTag_INT(b_word);
if (b == 0)
return pl_fd_not_domain(x_word, l_word, u_word);
return (b == 1) && Pl_Fd_Domain_Interval(x_word, min, max);
}
if (x_tag_mask == TAG_REF_MASK) /* make an FD var */
{
adr = UnTag_REF(x_word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
else
fdv_adr = UnTag_FDV(x_word);
r = Range(fdv_adr);
x_min = r->min;
x_max = r->max;
if (x_min >= min && x_max <= max)
{
b = 1;
goto unif_b;
}
if (min > max || x_max < min || x_min > max) /* NB: if L..U is empty then B = 0 */
{
b = 0;
goto unif_b;
}
if (!Pl_Fd_Check_For_Bool_Var(b_word))
return FALSE;
PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_OPEN_3 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Open_3(WamWord source_sink_word, WamWord mode_word, WamWord stm_word)
{
WamWord word, tag_mask;
int atom;
int mode;
Bool text;
StmProp prop;
char *path;
int atom_file_name;
int stm;
FILE *f;
int mask = SYS_VAR_OPTION_MASK;
Bool reposition;
DEREF(source_sink_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_ATM_MASK)
Pl_Err_Domain(pl_domain_source_sink, source_sink_word);
atom_file_name = UnTag_ATM(word);
path = pl_atom_tbl[atom_file_name].name;
if ((path = Pl_M_Absolute_Path_Name(path)) == NULL)
Pl_Err_Existence(pl_existence_source_sink, source_sink_word);
text = mask & 1;
mask >>= 1;
atom = Pl_Rd_Atom_Check(mode_word);
if (atom == pl_atom_read)
mode = STREAM_MODE_READ;
else if (atom == pl_atom_write)
mode = STREAM_MODE_WRITE;
else if (atom == pl_atom_append)
mode = STREAM_MODE_APPEND;
else
Pl_Err_Domain(pl_domain_io_mode, mode_word);
stm = Pl_Add_Stream_For_Stdio_File(path, mode, text);
if (stm < 0)
{
if (errno == ENOENT || errno == ENOTDIR)
Pl_Err_Existence(pl_existence_source_sink, source_sink_word);
else
Pl_Err_Permission(pl_permission_operation_open,
pl_permission_type_source_sink, source_sink_word);
}
prop = pl_stm_tbl[stm]->prop;
f = (FILE *) pl_stm_tbl[stm]->file;
/* change properties wrt to specified ones */
if ((mask & 2) != 0) /* reposition specified */
{
reposition = mask & 1;
if (reposition && !prop.reposition)
{
fclose(f);
word = Pl_Put_Structure(pl_atom_reposition, 1);
Pl_Unify_Atom(pl_atom_true);
Pl_Err_Permission(pl_permission_operation_open,
pl_permission_type_source_sink, word);
}
prop.reposition = reposition;
}
mask >>= 2;
if ((mask & 4) != 0) /* eof_action specified */
prop.eof_action = mask & 3;
mask >>= 3;
if ((mask & 4) != 0) /* buffering specified */
if (prop.buffering != (unsigned) (mask & 3)) /* cast for MSVC warning */
{
prop.buffering = mask & 3;
Pl_Stdio_Set_Buffering(f, prop.buffering);
}
mask >>= 3;
pl_stm_tbl[stm]->atom_file_name = atom_file_name;
pl_stm_tbl[stm]->prop = prop;
Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_PREDICATE_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Predicate_2(WamWord pred_indic_word, WamWord which_preds_word)
{
WamWord name_word, arity_word;
HashScan scan;
PredInf *pred;
int func, arity;
int func1, arity1;
int which_preds; /* 0=user, 1=user+bips, 2=user+bips+system */
Bool all;
func = Pl_Get_Pred_Indicator(pred_indic_word, FALSE, &arity);
name_word = pl_pi_name_word;
arity_word = pl_pi_arity_word;
which_preds = Pl_Rd_Integer(which_preds_word);
if (which_preds == 0 && !Flag_Value(FLAG_STRICT_ISO))
which_preds = 1;
#define Pred_Is_Ok(pred, func, which_preds) \
(which_preds == 2 || (pl_atom_tbl[func].name[0] != '$' && \
(which_preds == 1 || !(pred->prop & MASK_PRED_ANY_BUILTIN))))
if (func >= 0 && arity >= 0)
{
pred = Pl_Lookup_Pred(func, arity);
return pred && Pred_Is_Ok(pred, func, which_preds);
}
/* here func or arity == -1 (or both) */
all = (func == -1 && arity == -1);
pred = (PredInf *) Pl_Hash_First(pl_pred_tbl, &scan);
for (;;)
{
if (pred == NULL)
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;
pred = (PredInf *) Pl_Hash_Next(&scan);
}
/* non deterministic case */
A(0) = name_word;
A(1) = arity_word;
A(2) = which_preds;
A(3) = (WamWord) scan.endt;
A(4) = (WamWord) scan.cur_t;
A(5) = (WamWord) scan.cur_p;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PREDICATE_ALT, 0),
6);
return Pl_Get_Atom(Functor_Of(pred->f_n), name_word) &&
Pl_Get_Integer(Arity_Of(pred->f_n), arity_word);
/*
return Pl_Un_Atom_Check(Functor_Of(pred->f_n), name_word) &&
Pl_Un_Integer_Check(Arity_Of(pred->f_n), arity_word);
*/
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_OUTPUT_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Output_1(WamWord stm_word)
{
return Pl_Get_Integer(pl_stm_output, stm_word);
}
