/*-------------------------------------------------------------------------*
* 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_GET_PRED_INDICATOR *
* *
* returns the functor and initializes the arity of the predicate indicator*
* func= -1 if it is a variable, arity= -1 if it is a variable *
*-------------------------------------------------------------------------*/
int
Pl_Get_Pred_Indicator(WamWord pred_indic_word, Bool must_be_ground, int *arity)
{
WamWord word, tag_mask;
int func;
DEREF(pred_indic_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK && must_be_ground)
Pl_Err_Instantiation();
if (!Pl_Get_Structure(ATOM_CHAR('/'), 2, pred_indic_word))
{
if (!Flag_Value(FLAG_STRICT_ISO) &&
Pl_Rd_Callable(word, &func, arity) != NULL)
return func;
Pl_Err_Type(pl_type_predicate_indicator, pred_indic_word);
}
pl_pi_name_word = Pl_Unify_Variable();
pl_pi_arity_word = Pl_Unify_Variable();
if (must_be_ground)
func = Pl_Rd_Atom_Check(pl_pi_name_word);
else
{
DEREF(pl_pi_name_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
func = -1;
else
func = Pl_Rd_Atom_Check(pl_pi_name_word);
}
if (must_be_ground)
{
*arity = Pl_Rd_Positive_Check(pl_pi_arity_word);
if (*arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
}
else
{
DEREF(pl_pi_arity_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
*arity = -1;
else
{
*arity = Pl_Rd_Positive_Check(pl_pi_arity_word);
if (*arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
}
}
return func;
}
/*-------------------------------------------------------------------------*
* PL_SET_STREAM_POSITION_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Set_Stream_Position_2(WamWord sora_word, WamWord position_word)
{
WamWord word, tag_mask;
WamWord p_word[4];
int p[4];
int i;
int stm;
StmInf *pstm;
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);
DEREF(position_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
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)
Pl_Err_Instantiation();
if (tag_mask != TAG_INT_MASK)
goto dom_error;
p[i] = UnTag_INT(word);
}
return Pl_Stream_Set_Position(pstm, SEEK_SET, p[0], p[1], p[2], p[3]) == 0;
}
/*-------------------------------------------------------------------------*
* PL_BLT_FUNCTOR *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Functor(WamWord term_word, WamWord functor_word, WamWord arity_word)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord tag_functor;
int arity;
Bool res;
Pl_Set_C_Bip_Name("functor", 3);
DEREF(term_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
{
if (tag_mask == TAG_LST_MASK)
res = Pl_Un_Atom_Check(ATOM_CHAR('.'), functor_word) &&
Pl_Un_Integer_Check(2, arity_word);
else if (tag_mask == TAG_STC_MASK)
{
adr = UnTag_STC(word);
res = Pl_Un_Atom_Check(Functor(adr), functor_word) &&
Pl_Un_Integer_Check(Arity(adr), arity_word);
}
else
res = Pl_Unify(word, functor_word) && Pl_Un_Integer_Check(0, arity_word);
goto finish;
}
/* tag_mask == TAG_REF_MASK */
DEREF(functor_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK &&
tag_mask != TAG_FLT_MASK)
Pl_Err_Type(pl_type_atomic, functor_word);
tag_functor = tag_mask;
functor_word = word;
arity = Pl_Rd_Positive_Check(arity_word);
if (arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
if (tag_functor == TAG_ATM_MASK && UnTag_ATM(functor_word) == ATOM_CHAR('.')
&& arity == 2)
{
res = (Pl_Get_List(term_word)) ? Pl_Unify_Void(2), TRUE : FALSE;
goto finish;
}
if (tag_functor == TAG_ATM_MASK && arity > 0)
{
res = (Pl_Get_Structure(UnTag_ATM(functor_word), arity, term_word)) ?
Pl_Unify_Void(arity), TRUE : FALSE;
goto finish;
}
if (arity != 0)
Pl_Err_Type(pl_type_atom, functor_word);
res = Pl_Unify(functor_word, term_word);
finish:
Pl_Unset_C_Bip_Name();
return res;
}
