/*-------------------------------------------------------------------------*
* PL_SET_STREAM_LINE_COLUMN_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Set_Stream_Line_Column_3(WamWord sora_word, WamWord line_word,
WamWord col_word)
{
int stm;
StmInf *pstm;
PlLong line_count, line_pos;
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_binary_stream, sora_word);
line_count = Pl_Rd_Integer_Check(line_word) - 1;
line_pos = Pl_Rd_Integer_Check(col_word) - 1;
return line_count >= 0 && line_pos >= 0 &&
Pl_Stream_Set_Position_LC(pstm, line_count, line_pos) == 0;
}
/*-------------------------------------------------------------------------*
* 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_STREAM_PROP_EOF_ACTION_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_Eof_Action_2(WamWord eof_action_word, WamWord stm_word)
{
int stm;
int atom;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
switch (pl_stm_tbl[stm]->prop.eof_action)
{
case STREAM_EOF_ACTION_ERROR:
atom = pl_atom_error;
break;
case STREAM_EOF_ACTION_EOF_CODE:
atom = pl_atom_eof_code;
break;
case STREAM_EOF_ACTION_RESET:
atom = pl_atom_reset;
break;
}
return Pl_Un_Atom_Check(atom, eof_action_word);
}
/*-------------------------------------------------------------------------*
* PL_STREAM_PROP_BUFFERING_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_Buffering_2(WamWord buffering_word, WamWord stm_word)
{
int stm;
int atom;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
#ifndef NO_USE_LINEDIT /* if GUI: ask it for buffering */
if (pl_stm_tbl[stm]->file == (PlLong) stdout && pl_le_hook_get_line_buffering)
{
if ((*pl_le_hook_get_line_buffering)())
pl_stm_tbl[stm]->prop.buffering = STREAM_BUFFERING_LINE;
else
pl_stm_tbl[stm]->prop.buffering = STREAM_BUFFERING_NONE;
}
#endif
switch (pl_stm_tbl[stm]->prop.buffering)
{
case STREAM_BUFFERING_NONE:
atom = pl_atom_none;
break;
case STREAM_BUFFERING_LINE:
atom = pl_atom_line;
break;
case STREAM_BUFFERING_BLOCK:
atom = pl_atom_block;
break;
}
return Pl_Un_Atom_Check(atom, buffering_word);
}
/*-------------------------------------------------------------------------*
* PL_SET_STREAM_TYPE_2 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Set_Stream_Type_2(WamWord sora_word, WamWord is_text_word)
{
int stm;
StmInf *pstm;
int text;
stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST);
pstm = pl_stm_tbl[stm];
text = Pl_Rd_Integer_Check(is_text_word);
if ((unsigned) text == pstm->prop.text)
return;
if (pstm->char_count)
Pl_Err_Permission(pl_permission_operation_modify,
pl_permission_type_stream, sora_word);
pstm->prop.text = text;
#if defined(_WIN32) || defined(__CYGWIN__)
{
FILE *f;
f = Pl_Stdio_Desc_Of_Stream(stm);
if (f == NULL)
return;
setmode(fileno(f), (text) ? O_TEXT : O_BINARY);
}
#endif
}
/*-------------------------------------------------------------------------*
* PL_STREAM_PROP_END_OF_STREAM_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_End_Of_Stream_2(WamWord end_of_stream_word, WamWord stm_word)
{
int stm;
int atom;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
switch (Pl_Stream_End_Of_Stream(pl_stm_tbl[stm]))
{
case STREAM_EOF_NOT:
atom = pl_atom_not;
break;
case STREAM_EOF_AT:
atom = pl_atom_at;
break;
case STREAM_EOF_PAST:
atom = pl_atom_past;
break;
}
return Pl_Un_Atom_Check(atom, end_of_stream_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_ATOM_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Atom_2(WamWord atom_word, WamWord hide_word)
{
WamWord word, tag_mask;
Bool hide;
int atom;
hide = Pl_Rd_Integer_Check(hide_word);
DEREF(atom_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
return *Pl_Rd_String_Check(word) != '$' || !hide;
atom = -1;
for (;;)
{
atom = Pl_Find_Next_Atom(atom);
if (atom == -1)
return FALSE;
if (!hide || pl_atom_tbl[atom].name[0] != '$')
break;
}
/* non deterministic case */
A(0) = atom_word;
A(1) = hide;
A(2) = atom;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ATOM_ALT, 0), 3);
return Pl_Get_Atom(atom, atom_word);
}
/*-------------------------------------------------------------------------*
* 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_STREAM_PROP_MODE_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_Mode_2(WamWord mode_word, WamWord stm_word)
{
int stm;
int atom;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
switch (pl_stm_tbl[stm]->prop.mode)
{
case STREAM_MODE_READ:
atom = pl_atom_read;
break;
case STREAM_MODE_WRITE:
atom = pl_atom_write;
break;
case STREAM_MODE_APPEND:
atom = pl_atom_append;
break;
}
return Pl_Un_Atom_Check(atom, mode_word);
}
/*-------------------------------------------------------------------------*
* PL_STREAM_PROP_FILE_NAME_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_File_Name_2(WamWord file_name_word, WamWord stm_word)
{
int stm;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
return Pl_Un_Atom_Check(pl_stm_tbl[stm]->atom_file_name, file_name_word);
}
/*-------------------------------------------------------------------------*
* PL_STREAM_PROP_OUTPUT_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_Output_1(WamWord stm_word)
{
int stm;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
return pl_stm_tbl[stm]->prop.output;
}
/*-------------------------------------------------------------------------*
* ARG_INTEGER *
* *
*-------------------------------------------------------------------------*/
static long
Arg_Integer(WamWord **lst_adr)
{
WamWord word;
word = Read_Arg(lst_adr);
Pl_Math_Load_Value(word, &word);
return Pl_Rd_Integer_Check(word);
}
/*-------------------------------------------------------------------------*
* PL_DEFINE_MATH_BIP_2 *
* *
* Called by compiled prolog code. *
*-------------------------------------------------------------------------*/
void
Pl_Define_Math_Bip_2(WamWord func_word, WamWord arity_word)
{
char *cur_bip_func;
int cur_bip_arity;
cur_bip_func = Pl_Rd_String_Check(func_word);
cur_bip_arity = Pl_Rd_Integer_Check(arity_word);
Pl_Set_C_Bip_Name(cur_bip_func, cur_bip_arity);
}
/*-------------------------------------------------------------------------*
* PL_SET_STREAM_BUFFERING_2 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Set_Stream_Buffering_2(WamWord sora_word, WamWord buff_mode_word)
{
int stm;
StmInf *pstm;
stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST);
pstm = pl_stm_tbl[stm];
pstm->prop.buffering = Pl_Rd_Integer_Check(buff_mode_word);
Pl_Set_Stream_Buffering(stm);
}
/*-------------------------------------------------------------------------*
* PL_STREAM_PROP_REPOSITION_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_Reposition_2(WamWord reposition_word, WamWord stm_word)
{
int stm;
int atom;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
atom = (pl_stm_tbl[stm]->prop.reposition) ? pl_atom_true : pl_atom_false;
return Pl_Un_Atom_Check(atom, reposition_word);
}
/*-------------------------------------------------------------------------*
* PL_STREAM_PROP_TYPE_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Stream_Prop_Type_2(WamWord type_word, WamWord stm_word)
{
int stm;
int atom;
stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */
atom = (pl_stm_tbl[stm]->prop.text) ? pl_atom_text : pl_atom_binary;
return Pl_Un_Atom_Check(atom, type_word);
}
/*-------------------------------------------------------------------------*
* PL_SET_STREAM_EOF_ACTION_2 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Set_Stream_Eof_Action_2(WamWord sora_word, WamWord action_word)
{
int stm;
StmInf *pstm;
stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST);
pstm = pl_stm_tbl[stm];
if (pstm->prop.output)
Pl_Err_Permission(pl_permission_operation_modify,
pl_permission_type_stream, sora_word);
pstm->prop.eof_action = Pl_Rd_Integer_Check(action_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_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_HALT_IF_NO_TOP_LEVEL_1 *
* *
*-------------------------------------------------------------------------*/
WamCont
Pl_Halt_If_No_Top_Level_1(WamWord exit_code_word)
{
PredInf *pred;
int x;
x = Pl_Rd_Integer_Check(exit_code_word);
if (SYS_VAR_TOP_LEVEL == 0) /* no top level running */
Pl_Exit_With_Value(x);
pred = Pl_Lookup_Pred(Pl_Create_Atom((x) ? "$top_level_abort" : "$top_level_stop"), 0);
if (pred == NULL) /* should not occur */
Pl_Exit_With_Value(x);
return (WamCont) (pred->codep);
}
/*-------------------------------------------------------------------------*
* 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_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_HALT_1 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Halt_1(WamWord exit_code_word)
{
Pl_Exit_With_Value(Pl_Rd_Integer_Check(exit_code_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;
}
