/*-------------------------------------------------------------------------*
* CTRL_C_MANAGER *
* *
*-------------------------------------------------------------------------*/
static PlLong
Ctrl_C_Manager(int from_callback)
{
StmInf *pstm = pl_stm_tbl[pl_stm_top_level_output];
PredInf *pred;
int c;
CodePtr to_execute;
// Pl_Reset_Prolog_In_Signal();
Restore_Machine_Regs(buff_save_machine_regs);
start:
Pl_Stream_Printf(pstm, "\nProlog interruption (h for help) ? ");
Pl_Stream_Flush(pstm);
c = Pl_Stream_Get_Key(pl_stm_tbl[pl_stm_top_level_input], TRUE, FALSE);
Pl_Stream_Putc('\n', pstm);
switch (c)
{
case 'a': /* abort */
to_execute = Prolog_Predicate(ABORT, 0);
if (from_callback)
return (PlLong) to_execute;
Pl_Execute_A_Continuation(to_execute);
break;
case 'b': /* break */
Pl_Call_Prolog(Prolog_Predicate(BREAK, 0));
goto start;
break;
case 'c': /* continue */
break;
case 'e': /* exit */
Pl_Exit_With_Value(0);
case 't': /* trace */
case 'd': /* debug */
if (SYS_VAR_DEBUGGER)
{
pred = Pl_Lookup_Pred(Pl_Create_Atom((c == 't') ? "trace" : "debug"), 0);
if (pred == NULL)
Pl_Fatal_Error(ERR_DEBUGGER_NOT_FOUND); /* should not occur */
Pl_Call_Prolog((CodePtr) pred->codep);
break;
}
default: /* help */
Pl_Stream_Printf(pstm, " a abort b break\n");
Pl_Stream_Printf(pstm, " c continue e exit\n");
if (SYS_VAR_DEBUGGER)
Pl_Stream_Printf(pstm, " d debug t trace\n");
Pl_Stream_Printf(pstm, " h/? help\n");
goto start;
}
return 0;
}
/*-------------------------------------------------------------------------*
* 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_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_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_CURRENT_ATOM_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Atom_Alt_0(void)
{
WamWord atom_word;
Bool hide;
int atom;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ATOM_ALT, 0), 0);
atom_word = AB(B, 0);
hide = AB(B, 1);
atom = AB(B, 2);
for (;;)
{
atom = Pl_Find_Next_Atom(atom);
if (atom == -1)
{
Delete_Last_Choice_Point();
return FALSE;
}
if (!hide || pl_atom_tbl[atom].name[0] != '$')
break;
}
/* non deterministic case */
#if 0 /* the following data is unchanged */
AB(B, 0) = atom_word;
AB(B, 1) = hide;
#endif
AB(B, 2) = atom;
return Pl_Get_Atom(atom, atom_word);
}
/*-------------------------------------------------------------------------*
* PL_GROUP_SOLUTIONS_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Group_Solutions_Alt_0(void)
{
WamWord all_sol_word, gl_key_word, sol_word;
WamWord word;
WamWord key_word;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0),
0);
all_sol_word = AB(B, 0);
gl_key_word = AB(B, 1);
sol_word = AB(B, 2);
word = Group(all_sol_word, gl_key_word, &key_word);
if (word == NOT_A_WAM_WORD)
Delete_Last_Choice_Point();
else /* non deterministic case */
{
AB(B, 0) = word;
#if 0 /* the following data is unchanged */
AB(B, 1) = gl_key_word;
AB(B, 2) = sol_word;
#endif
}
Pl_Unify(key_word, gl_key_word);
return Pl_Unify(sol_word, all_sol_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 */
}
/*-------------------------------------------------------------------------*
* PREPARE_CALL *
* *
*-------------------------------------------------------------------------*/
static CodePtr
Prepare_Call(int func, int arity, WamWord *arg_adr)
{
PredInf *pred;
WamWord *w;
int i;
int bip_func, bip_arity;
pred = Pl_Lookup_Pred(func, arity);
if (pred == NULL || !(pred->prop & MASK_PRED_NATIVE_CODE) ||
(pred->prop & MASK_PRED_CONTROL_CONSTRUCT))
{
if (arity == 0)
A(0) = Tag_ATM(func);
else
{
w = goal_H;
A(0) = Tag_STC(w);
*w++ = Functor_Arity(func, arity);
for (i = 0; i < arity; i++)
*w++ = *arg_adr++;
}
bip_func = Pl_Get_Current_Bip(&bip_arity);
A(1) = Tag_INT(Call_Info(bip_func, bip_arity, 0));
return (CodePtr) Prolog_Predicate(CALL_INTERNAL, 2);
}
for (i = 0; i < arity; i++)
A(i) = *arg_adr++;
return (CodePtr) (pred->codep);
}
/*-------------------------------------------------------------------------*
* 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_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_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_QUERY_BEGIN *
* *
*-------------------------------------------------------------------------*/
void
Pl_Query_Begin(Bool recoverable)
{
if (query_stack_top - query_stack >= QUERY_STACK_SIZE)
Pl_Fatal_Error("too many nested Pl_Query_Start() (max: %d)",
QUERY_STACK_SIZE);
if (recoverable)
Pl_Create_Choice_Point(Prolog_Predicate(PL_QUERY_RECOVER_ALT, 0), 0);
}
/*-------------------------------------------------------------------------*
* 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);
}
/*-------------------------------------------------------------------------*
* 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_CURRENT_ALIAS_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Alias_Alt_0(void)
{
int stm;
WamWord alias_word;
HashScan scan;
AliasInf *alias;
AliasInf *save_alias;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ALIAS_ALT, 0), 0);
stm = AB(B, 0);
alias_word = AB(B, 1);
scan.endt = (char *) AB(B, 2);
scan.cur_t = (char *) AB(B, 3);
scan.cur_p = (char *) AB(B, 4);
alias = (AliasInf *) AB(B, 5);
save_alias = alias;
for (;;)
{
alias = (AliasInf *) Pl_Hash_Next(&scan);
if (alias == NULL || alias->stm == stm)
break;
}
if (alias) /* non deterministic case */
{
#if 0 /* the following data is unchanged */
AB(B, 0) = stm;
AB(B, 1) = alias_word;
AB(B, 2) = (WamWord) scan.endt;
#endif
AB(B, 3) = (WamWord) scan.cur_t;
AB(B, 4) = (WamWord) scan.cur_p;
AB(B, 5) = (WamWord) alias;
}
else
Delete_Last_Choice_Point();
Pl_Get_Atom(save_alias->atom, alias_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_QUERY_END *
* *
*-------------------------------------------------------------------------*/
void
Pl_Query_End(int op)
{
WamWord *query_b, *prev_b, *b;
Bool recoverable;
if (query_stack_top == query_stack)
Pl_Fatal_Error("Pl_Query_End() but no query remaining");
query_b = *--query_stack_top;
pl_query_top_b = query_stack_top[-1];
recoverable =
(ALTB(query_b) == Prolog_Predicate(PL_QUERY_RECOVER_ALT, 0));
prev_b = BB(query_b);
switch (op)
{
case PL_RECOVER:
Assign_B(query_b);
if (!recoverable)
Pl_Fatal_Error("Pl_Query_End(PL_RECOVER) but unrecoverable query");
Pl_Delete_Choice_Point(0); /* remove recover chc-point */
break;
case PL_CUT:
Assign_B((recoverable) ? prev_b : query_b);
break;
default: /* case PL_KEEP_FOR_PROLOG */
if (recoverable)
{
if (B == query_b)
Assign_B(prev_b);
else
for (b = B; b > query_b; b = BB(b)) /* unlink recover chc-point */
if (BB(b) == query_b)
BB(b) = prev_b;
}
Pl_Keep_Rest_For_Prolog(query_b);
}
}
/*-------------------------------------------------------------------------*
* PL_ATOM_CONCAT_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Atom_Concat_Alt_0(void)
{
WamWord atom1_word, atom2_word;
AtomInf *patom3;
char *name;
char *p;
char *str;
int l;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(ATOM_CONCAT_ALT, 0), 0);
atom1_word = AB(B, 0);
atom2_word = AB(B, 1);
patom3 = (AtomInf *) AB(B, 2);
p = (char *) AB(B, 3);
if (*p == '\0')
Delete_Last_Choice_Point();
else /* non deterministic case */
{
#if 0 /* the following data is unchanged */
AB(B, 0) = atom1_word;
AB(B, 1) = atom2_word;
AB(B, 2) = (WamWord) patom3;
#endif
AB(B, 3) = (WamWord) (p + 1);
}
name = patom3->name;
l = p - name;
MALLOC_STR(l);
strncpy(str, name, l + 1);
str[l] = '\0';
if (!Pl_Get_Atom(Create_Malloc_Atom(str), atom1_word))
return FALSE;
l = patom3->prop.length - l;
MALLOC_STR(l);
strcpy(str, p);
return Pl_Get_Atom(Create_Malloc_Atom(str), atom2_word);
}
/*-------------------------------------------------------------------------*
* PL_GROUP_SOLUTIONS_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Group_Solutions_3(WamWord all_sol_word, WamWord gl_key_word,
WamWord sol_word)
{
WamWord word, tag_mask;
WamWord key_word;
DEREF(all_sol_word, word, tag_mask);
if (word == NIL_WORD)
return FALSE;
word = Group(all_sol_word, gl_key_word, &key_word);
if (word != NOT_A_WAM_WORD)
{
A(0) = word;
A(1) = gl_key_word;
A(2) = sol_word;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0), 3);
}
Pl_Unify(key_word, gl_key_word);
return Pl_Unify(sol_word, all_sol_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_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_ATOM_CONCAT_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Atom_Concat_3(WamWord atom1_word, WamWord atom2_word, WamWord atom3_word)
{
WamWord word, tag_mask;
int tag1, tag2, tag3;
AtomInf *patom1, *patom2, *patom3;
char *str;
int l;
DEREF(atom1_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
Pl_Err_Type(pl_type_atom, atom1_word);
tag1 = tag_mask;
atom1_word = word;
DEREF(atom2_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
Pl_Err_Type(pl_type_atom, atom2_word);
tag2 = tag_mask;
atom2_word = word;
DEREF(atom3_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
Pl_Err_Type(pl_type_atom, atom3_word);
tag3 = tag_mask;
atom3_word = word;
if (tag3 == TAG_REF_MASK && (tag1 == TAG_REF_MASK || tag2 == TAG_REF_MASK))
Pl_Err_Instantiation();
if (tag1 == TAG_ATM_MASK)
{
patom1 = pl_atom_tbl + UnTag_ATM(atom1_word);
if (tag2 == TAG_ATM_MASK)
{
patom2 = pl_atom_tbl + UnTag_ATM(atom2_word);
l = patom1->prop.length + patom2->prop.length;
MALLOC_STR(l);
strcpy(str, patom1->name);
strcpy(str + patom1->prop.length, patom2->name);
return Pl_Get_Atom(Create_Malloc_Atom(str), atom3_word);
}
patom3 = pl_atom_tbl + UnTag_ATM(atom3_word);
l = patom3->prop.length - patom1->prop.length;
if (l < 0 || strncmp(patom1->name, patom3->name, patom1->prop.length) != 0)
return FALSE;
MALLOC_STR(l);
strcpy(str, patom3->name + patom1->prop.length);
return Pl_Get_Atom(Create_Malloc_Atom(str), atom2_word);
}
if (tag2 == TAG_ATM_MASK) /* here tag1 == REF */
{
patom2 = pl_atom_tbl + UnTag_ATM(atom2_word);
patom3 = pl_atom_tbl + UnTag_ATM(atom3_word);
l = patom3->prop.length - patom2->prop.length;
if (l < 0 || strncmp(patom2->name, patom3->name + l, patom2->prop.length) != 0)
return FALSE;
MALLOC_STR(l);
strncpy(str, patom3->name, l);
str[l] = '\0';
return Pl_Get_Atom(Create_Malloc_Atom(str), atom1_word);
}
/* A1 and A2 are variables: non deterministic case */
patom3 = pl_atom_tbl + UnTag_ATM(atom3_word);
if (patom3->prop.length > 0)
{
A(0) = atom1_word;
A(1) = atom2_word;
A(2) = (WamWord) patom3;
A(3) = (WamWord) (patom3->name + 1);
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(ATOM_CONCAT_ALT, 0), 4);
}
return Pl_Get_Atom(pl_atom_void, atom1_word) &&
Pl_Get_Atom_Tagged(atom3_word, atom2_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);
*/
}