/*-------------------------------------------------------------------------*
* 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_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_ATOM_LENGTH_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Atom_Length_2(WamWord atom_word, WamWord length_word)
{
int atom;
atom = Pl_Rd_Atom_Check(atom_word);
return Pl_Un_Positive_Check(pl_atom_tbl[atom].prop.length, length_word);
}
/*-------------------------------------------------------------------------*
* PL_AUX_NAME_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Aux_Name_1(WamWord name_word)
{
int func;
func = Pl_Rd_Atom_Check(name_word);
return Pl_Detect_If_Aux_Name(func) != NULL;
}
/*-------------------------------------------------------------------------*
* PL_ADD_STREAM_ALIAS_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Add_Stream_Alias_2(WamWord sora_word, WamWord alias_word)
{
int stm;
stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST);
return Pl_Add_Alias_To_Stream(Pl_Rd_Atom_Check(alias_word), stm);
}
/*-------------------------------------------------------------------------*
* 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);
}
/*-------------------------------------------------------------------------*
* ARG_ATOM *
* *
*-------------------------------------------------------------------------*/
static char *
Arg_Atom(WamWord **lst_adr)
{
WamWord word;
word = Read_Arg(lst_adr);
return pl_atom_tbl[Pl_Rd_Atom_Check(word)].name;
}
/*-------------------------------------------------------------------------*
* PL_NEW_ATOM_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_New_Atom_2(WamWord prefix_word, WamWord atom_word)
{
int atom;
atom = Pl_Rd_Atom_Check(prefix_word);
Pl_Check_For_Un_Variable(atom_word);
return Pl_Get_Atom(Pl_Gen_New_Atom(pl_atom_tbl[atom].name), atom_word);
}
/*-------------------------------------------------------------------------*
* PL_PRED_WITHOUT_AUX_4 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Pred_Without_Aux_4(WamWord name_word, WamWord arity_word,
WamWord name1_word, WamWord arity1_word)
{
int func, arity;
int func1, arity1;
func = Pl_Rd_Atom_Check(name_word);
arity = Pl_Rd_Integer_Check(arity_word);
func1 = Pl_Pred_Without_Aux(func, arity, &arity1);
return Pl_Un_Atom_Check(func1, name1_word) &&
Pl_Un_Integer_Check(arity1, arity1_word);
}
/*-------------------------------------------------------------------------*
* PL_FATHER_OF_AUX_NAME_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Father_Of_Aux_Name_3(WamWord name_word, WamWord father_name_word,
WamWord father_arity_word)
{
int func, father_func, father_arity;
func = Pl_Rd_Atom_Check(name_word);
father_func = Pl_Father_Pred_Of_Aux(func, &father_arity);
if (father_func < 0)
return FALSE;
return Pl_Un_Atom_Check(father_func, father_name_word) &&
Pl_Un_Integer_Check(father_arity, father_arity_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_ALIAS_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Alias_2(WamWord stm_word, WamWord alias_word)
{
WamWord word, tag_mask;
int stm;
HashScan scan;
AliasInf *alias;
AliasInf *save_alias;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
DEREF(alias_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(word)) == stm;
for (alias = (AliasInf *) Pl_Hash_First(pl_alias_tbl, &scan); alias;
alias = (AliasInf *) Pl_Hash_Next(&scan))
if (alias->stm == stm)
break;
if (alias == NULL)
return FALSE;
save_alias = alias;
for (;;)
{
alias = (AliasInf *) Pl_Hash_Next(&scan);
if (alias == NULL || alias->stm == stm)
break;
}
if (alias) /* non deterministic case */
{
A(0) = stm;
A(1) = alias_word;
A(2) = (WamWord) scan.endt;
A(3) = (WamWord) scan.cur_t;
A(4) = (WamWord) scan.cur_p;
A(5) = (WamWord) alias;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ALIAS_ALT, 0),
6);
}
Pl_Get_Atom(save_alias->atom, alias_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_MAKE_AUX_NAME_4 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Make_Aux_Name_4(WamWord name_word, WamWord arity_word,
WamWord aux_nb_word, WamWord aux_name_word)
{
int func, arity;
int aux_nb;
int aux_name;
func = Pl_Rd_Atom_Check(name_word);
arity = Pl_Rd_Integer_Check(arity_word);
aux_nb = Pl_Rd_Integer_Check(aux_nb_word);
aux_name = Pl_Make_Aux_Name(func, arity, aux_nb);
return Pl_Un_Atom_Check(aux_name, aux_name_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_SET_PREDICATE_FILE_INFO_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Set_Predicate_File_Info_3(WamWord pred_indic_word,
WamWord pl_file_word, WamWord pl_line_word)
{
int func, arity;
int pl_file, pl_line;
PredInf *pred;
func = Pl_Get_Pred_Indicator(pred_indic_word, TRUE, &arity);
if ((pred = Pl_Lookup_Pred(func, arity)) == NULL)
return FALSE;
pl_file = Pl_Rd_Atom_Check(pl_file_word);
pl_line = Pl_Rd_Integer_Check(pl_line_word);
if (pl_line < 0)
return FALSE;
pred->pl_file = pl_file;
pred->pl_line = pl_line;
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_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_TEST_ALIAS_NOT_ASSIGNED_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Test_Alias_Not_Assigned_1(WamWord alias_word)
{
return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(alias_word)) < 0;
}