示例#1
0
/*-------------------------------------------------------------------------*
 * 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;
}
示例#2
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);
}
示例#3
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#4
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#5
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#6
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#7
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 */
}
示例#8
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#9
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#10
0
/*-------------------------------------------------------------------------*
 * 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 */
}
示例#11
0
文件: pred_c.c 项目: adinho/Testing
/*-------------------------------------------------------------------------*
 * 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);
}
示例#12
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#13
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);
}
示例#14
0
/*-------------------------------------------------------------------------*
 * 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;
}
示例#15
0
/*-------------------------------------------------------------------------*
 * 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;
}
示例#16
0
/*-------------------------------------------------------------------------*
 * 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);
    }
}
示例#17
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#18
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#19
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#20
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#21
0
/*-------------------------------------------------------------------------*
 * 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);
}
示例#22
0
文件: pred_c.c 项目: adinho/Testing
/*-------------------------------------------------------------------------*
 * 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);
  */
}