Exemple #1
0
static CELL *
mark_global_cell(CELL *pt)
{   
  CELL reg = *pt;

  if (IsVarTerm(reg)) {
    /* skip bitmaps */
    switch(reg) {
    case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
      return pt + 4;
#else
      return pt + 3;
#endif
    case (CELL)FunctorString:
      return pt + 3 + pt[1];
    case (CELL)FunctorBigInt:
      {
	Int sz = 3 +
	  (sizeof(MP_INT)+
	   (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
	Opaque_CallOnGCMark f;
	Opaque_CallOnGCRelocate f2;
	Term t = AbsAppl(pt);

	if ( (f = Yap_blob_gc_mark_handler(t)) ) {
	  CELL ar[256];
	  Int i,n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, 256);
	  if (n < 0) {
	    Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"not enough space for slot internal variables in agc");
	      }
	  for (i = 0; i< n; i++) {
	    CELL *pt = ar+i;
	    CELL reg = *pt;
	    if (!IsVarTerm(reg) && IsAtomTerm(reg)) {
	      *pt = AtomTermAdjust(reg);
	    }
	  }
	  if ( (f2 = Yap_blob_gc_relocate_handler(t)) < 0 ) {
	    int out = (f2)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, n);
	    if (out < 0)
	      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"bad restore of slot internal variables in agc");
	  }
	}

	return pt + sz;
      }
    case (CELL)FunctorLongInt:
      return pt + 3;
      break;
    }
  } else if (IsAtomTerm(reg)) {
    MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
    return pt+1;
  }
  return pt+1;
}
Exemple #2
0
/** @pred  set_value(+ _A_,+ _C_)


    Associate atom  _A_ with constant  _C_.

    The `set_value` and `get_value` built-ins give a fast alternative to
    the internal data-base. This is a simple form of implementing a global
    counter.

    ~~~~~
    read_and_increment_counter(Value) :-
    get_value(counter, Value),
    Value1 is Value+1,
    set_value(counter, Value1).
    ~~~~~
    This predicate is YAP specific.
*/
static Int p_setval(USES_REGS1) { /* '$set_value'(+Atom,+Atomic) */
  Term t1 = Deref(ARG1), t2 = Deref(ARG2);
  if (!IsVarTerm(t1) && IsAtomTerm(t1) &&
      (!IsVarTerm(t2) && (IsAtomTerm(t2) || IsNumTerm(t2)))) {
    Yap_PutValue(AtomOfTerm(t1), t2);
    return (TRUE);
  }
  return (FALSE);
}
Exemple #3
0
static Int               /* mpe_create_state(+Event,+Event,+Text,+Colour) */
p_create_state()
{
  Term t_start = Deref(ARG1), t_end = Deref(ARG2),
    t_descr = Deref(ARG3), t_colour = Deref(ARG4);
  Int start_id, end_id;
  char *descr, *colour;
  int retv;

  /* The first and second args must be bount to integer event IDs. */
  if (IsVarTerm(t_start)) {
    Yap_Error(INSTANTIATION_ERROR, t_start, "mpe_create_state");
    return (FALSE);
  } else if( !IsIntegerTerm(t_start) ) {
    Yap_Error(TYPE_ERROR_INTEGER, t_start, "mpe_create_state");
    return (FALSE);
  } else {
    start_id = IntOfTerm(t_start);
  }
  if (IsVarTerm(t_end)) {
    Yap_Error(INSTANTIATION_ERROR, t_end, "mpe_create_state");
    return (FALSE);
  } else if( !IsIntegerTerm(t_end) ) {
    Yap_Error(TYPE_ERROR_INTEGER, t_end, "mpe_create_state");
    return (FALSE);
  } else {
    end_id = IntOfTerm(t_end);
  }

  /* The third and fourth args must be bound to atoms. */
  if (IsVarTerm(t_descr)) {
    Yap_Error(INSTANTIATION_ERROR, t_descr, "mpe_create_state");
    return (FALSE);
  } else if( !IsAtomTerm(t_descr) ) {
    Yap_Error(TYPE_ERROR_ATOM, t_descr, "mpe_create_state");
    return (FALSE);
  } else {
    descr = RepAtom(AtomOfTerm(t_descr))->StrOfAE;
  }
  if (IsVarTerm(t_colour)) {
    Yap_Error(INSTANTIATION_ERROR, t_colour, "mpe_create_state");
    return (FALSE);
  } else if( !IsAtomTerm(t_colour) ) {
    Yap_Error(TYPE_ERROR_ATOM, t_colour, "mpe_create_state");
    return (FALSE);
  } else {
    colour = RepAtom(AtomOfTerm(t_colour))->StrOfAE;
  }

  retv = MPE_Describe_state( (int)start_id, (int)end_id, descr, colour );

  return (retv == 0);
}
Exemple #4
0
/**
 * Specify an alias to the stream. The alias <tt>Name</tt> must be an atom. The
 * alias can be used instead of the stream descriptor for every operation
 * concerning the stream.
 *
 * @param + _tname_ Name of Alias
 * @param + _tstream_ stream identifier
 *
 * @return
 */
static Int add_alias_to_stream (USES_REGS1)
{
  Term tname = Deref(ARG1);
  Term tstream = Deref(ARG2);
  Atom at;
  Int sno;

  if (IsVarTerm(tname)) {
    Yap_Error(INSTANTIATION_ERROR, tname, "$add_alias_to_stream");
    return (FALSE);
  } else if (!IsAtomTerm (tname)) {
    Yap_Error(TYPE_ERROR_ATOM, tname, "$add_alias_to_stream");
    return (FALSE);
  }
  if (IsVarTerm(tstream)) {
    Yap_Error(INSTANTIATION_ERROR, tstream, "$add_alias_to_stream");
    return (FALSE);
  } else if (!IsApplTerm (tstream) || FunctorOfTerm (tstream) != FunctorStream ||
	     !IsIntTerm(ArgOfTerm(1,tstream))) {
    Yap_Error(DOMAIN_ERROR_STREAM_OR_ALIAS, tstream, "$add_alias_to_stream");
    return (FALSE);
  }
  at = AtomOfTerm(tname);
  sno = (int)IntOfTerm(ArgOfTerm(1,tstream));
  if (Yap_AddAlias(at, sno))
    return(TRUE);
  /* we could not create the alias, time to close the stream */
  Yap_CloseStream(sno);
  Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, tname, "open/3");
  return (FALSE);
}
Exemple #5
0
/*
 * Here we initialize the arguments indexing
 */
YAP_Int
p_udi_args_init(Term spec, int arity, UdiInfo blk)
{
	int i;
	Term arg;
	Atom idxtype;
	UdiControlBlock *cb;
	struct udi_p_args p_arg;

	for (i = 1; i <= arity; i++) {
		arg = ArgOfTerm(i,spec);
		if (IsAtomTerm(arg)) {
			idxtype = AtomOfTerm(arg);
			if (idxtype == AtomMinus) //skip this argument
				continue;
			p_arg.control = NULL;
			cb = NULL;
			while ((cb = (UdiControlBlock *) utarray_next(indexing_structures, cb))) {
				if (idxtype == (*cb)->decl){
					p_arg.arg = i;
					p_arg.control = *cb;
					p_arg.idxstr = (*cb)->init(spec, i, arity);
					utarray_push_back(blk->args, &p_arg);
				}
			}
			if (p_arg.control == NULL){ /* not "-" and not found */
				fprintf(stderr, "Invalid Spec (%s)\n", AtomName(idxtype));
				return FALSE;
			}
		}
	}
	return TRUE;
}
Exemple #6
0
static inline Term
TermToGlobalOrAtomAdjust(Term t)
{
  if (t && IsAtomTerm(t))
    return AtomTermAdjust(t);
  return t;
}
Exemple #7
0
static CELL *
mark_global_cell(CELL *pt)
{   
  CELL reg = *pt;

  if (IsVarTerm(reg)) {
    /* skip bitmaps */
    switch(reg) {
    case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
      return pt + 4;
#else
      return pt + 3;
#endif
    case (CELL)FunctorBigInt:
      {
	Int sz = 3 +
	  (sizeof(MP_INT)+
	   (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
	return pt + sz;
      }
    case (CELL)FunctorLongInt:
      return pt + 3;
      break;
    }
  } else if (IsAtomTerm(reg)) {
    MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
    return pt+1;
  }
  return pt+1;
}
Exemple #8
0
/** @pred  compare( _C_, _X_, _Y_) is iso


As a result of comparing  _X_ and  _Y_,  _C_ may take one of
the following values:

+
`=` if  _X_ and  _Y_ are identical;
+
`<` if  _X_ precedes  _Y_ in the defined order;
+
`>` if  _Y_ precedes  _X_ in the defined order;

*/
Int p_compare(USES_REGS1) { /* compare(?Op,?T1,?T2)	 */
  Int r = compare(Deref(ARG2), Deref(ARG3));
  Atom p;
  Term t = Deref(ARG1);
  if (r < 0)
    p = AtomLT;
  else if (r > 0)
    p = AtomGT;
  else
    p = AtomEQ;
  if (!IsVarTerm(t)) {
    if (IsAtomTerm(t)) {
      Atom a = AtomOfTerm(t);
      if (a == p)
        return true;
      if (a != AtomLT && a != AtomGT && a != AtomEq)
        Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
    } else {
      Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
    }
    return false;
  }

  return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
Exemple #9
0
static Int access_path(USES_REGS1) {
  Term tname = Deref(ARG1);

  if (IsVarTerm(tname)) {
    Yap_Error(INSTANTIATION_ERROR, tname, "access");
    return false;
  } else if (!IsAtomTerm(tname)) {
    Yap_Error(TYPE_ERROR_ATOM, tname, "access");
    return false;
  } else {
          VFS_t *vfs;
          char *s =  RepAtom(AtomOfTerm(tname))->StrOfAE;
          if (!s) return false;
          if ((vfs = vfs_owner(s))) {
              vfs_stat st;
              bool rc = vfs->stat(vfs, s, &st);
              UNLOCK(GLOBAL_Stream[sno].streamlock);
              return rc;
          }
#if HAVE_STAT
    struct SYSTEM_STAT ss;
    char *file_name;

    file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
    if (SYSTEM_STAT(file_name, &ss) != 0) {
      /* ignore errors while checking a file */
      return true;
    }
    return true;
#else
    return false;
#endif
  }
}
Exemple #10
0
static Int file_exists(USES_REGS1) {
  Term tname = Deref(ARG1);
  char *file_name;

  if (IsVarTerm(tname)) {
    Yap_Error(INSTANTIATION_ERROR, tname, "access");
    return FALSE;
  } else if (!IsAtomTerm(tname)) {
    Yap_Error(TYPE_ERROR_ATOM, tname, "access");
    return FALSE;
  } else {
#if HAVE_STAT
    struct SYSTEM_STAT ss;

    file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
    if (SYSTEM_STAT(file_name, &ss) != 0) {
      if (errno == ENOENT)
        return false;
      PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, tname, "error %s",
                strerror(errno));
      return false;
    }
    return true;
#else
    return FALSE;
#endif
  }
}
Exemple #11
0
static Int exists_directory(USES_REGS1) {
  Term tname = Deref(ARG1);
  char *file_name;

  if (IsVarTerm(tname)) {
    Yap_Error(INSTANTIATION_ERROR, tname, "exists_directory/1");
    return FALSE;
  } else if (!IsAtomTerm(tname)) {
    Yap_Error(TYPE_ERROR_ATOM, tname, "exists_directory/1");
    return FALSE;
  } else {
    VFS_t *vfs;
    char *s = Yap_VF(RepAtom(AtomOfTerm(tname))->StrOfAE);
    if (!s) return false;
    if ((vfs = vfs_owner(s))) {
bool rc = true;
      return vfs->isdir(vfs, s);

      UNLOCK(GLOBAL_Stream[sno].streamlock);
      return rc;
    }
#if HAVE_STAT
    struct SYSTEM_STAT ss;

    file_name = Yap_VF(RepAtom(AtomOfTerm(tname))->StrOfAE);
    if (SYSTEM_STAT(file_name, &ss) != 0) {
      /* ignore errors while checking a file */
      return false;
    }
    return (S_ISDIR(ss.st_mode));
#else
    return FALSE;
#endif
  }
}
Exemple #12
0
static void
mark_local(void)
{
  CELL   *pt;

  /* Adjusting the local */
  pt = LCL0;
  /* moving the trail is simple */
  while (pt > ASP) {
    CELL reg = *--pt;

    if (!IsVarTerm(reg)) {
      if (IsAtomTerm(reg)
#ifdef TABLING
	  /* assume we cannot have atoms on first page,
	     so this must be an arity
	  */
	  && reg > Yap_page_size
#endif
	  ) {
	MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
      }
    }
  }
}
Exemple #13
0
void Yap_PrintPredName(PredEntry *ap) {
  CACHE_REGS
  Term tmod = ap->ModuleOfPred;
  if (!tmod)
    tmod = TermProlog;
#if THREADS
  Yap_DebugPlWrite(MkIntegerTerm(worker_id));
  Yap_DebugPutc(stderr, ' ');
#endif
  Yap_DebugPutc(stderr, '>');
  Yap_DebugPutc(stderr, '\t');
  Yap_DebugPlWrite(tmod);
  Yap_DebugPutc(stderr, ':');
  if (ap->ModuleOfPred == IDB_MODULE) {
    Term t = Deref(ARG1);
    if (IsAtomTerm(t)) {
      Yap_DebugPlWrite(t);
    } else if (IsIntegerTerm(t)) {
      Yap_DebugPlWrite(t);
    } else {
      Functor f = FunctorOfTerm(t);
      Atom At = NameOfFunctor(f);
      Yap_DebugPlWrite(MkAtomTerm(At));
      Yap_DebugPutc(stderr, '/');
      Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
    }
  } else {
    if (ap->ArityOfPE == 0) {
      Atom At = (Atom)ap->FunctorOfPred;
      Yap_DebugPlWrite(MkAtomTerm(At));
    } else {
      Functor f = ap->FunctorOfPred;
      Atom At = NameOfFunctor(f);
      Yap_DebugPlWrite(MkAtomTerm(At));
      Yap_DebugPutc(stderr, '/');
      Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
    }
  }
  char s[1024];
  if (ap->PredFlags & StandardPredFlag)
    fprintf(stderr, "S");
  if (ap->PredFlags & CPredFlag)
    fprintf(stderr, "C");
  if (ap->PredFlags & UserCPredFlag)
    fprintf(stderr, "U");
  if (ap->PredFlags & SyncPredFlag)
    fprintf(stderr, "Y");
  if (ap->PredFlags & LogUpdatePredFlag)
    fprintf(stderr, "Y");
  if (ap->PredFlags & HiddenPredFlag)
    fprintf(stderr, "H");
  sprintf(s, "   %llx\n", ap->PredFlags);
  Yap_DebugPuts(stderr, s);
}
Exemple #14
0
/** @pred  get_value(+ _A_,- _V_)
    In YAP, atoms can be associated with constants. If one such
    association exists for atom  _A_, unify the second argument with the
    constant. Otherwise, unify  _V_ with `[]`.

    This predicate is YAP specific.
*/
static Int p_value(USES_REGS1) { /* '$get_value'(+Atom,?Val) */
  Term t1 = Deref(ARG1);
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, "get_value/2");
    return (FALSE);
  }
  if (!IsAtomTerm(t1)) {
    Yap_Error(TYPE_ERROR_ATOM, t1, "get_value/2");
    return (FALSE);
  }
  return (Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1))));
}
Exemple #15
0
static Int p_values(USES_REGS1) { /* '$values'(Atom,Old,New) */
  Term t1 = Deref(ARG1), t3 = Deref(ARG3);

  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, "set_value/2");
    return (FALSE);
  }
  if (!IsAtomTerm(t1)) {
    Yap_Error(TYPE_ERROR_ATOM, t1, "set_value/2");
    return (FALSE);
  }
  if (!Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1)))) {
    return (FALSE);
  }
  if (!IsVarTerm(t3)) {
    if (IsAtomTerm(t3) || IsNumTerm(t3)) {
      Yap_PutValue(AtomOfTerm(t1), t3);
    } else
      return (FALSE);
  }
  return (TRUE);
}
Exemple #16
0
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
  Term t0 = t;
  ap = nullptr;
restart:
  if (IsVarTerm(t)) {
    throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
  } else if (IsAtomTerm(t)) {
    ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
    ts = nullptr;
  } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
    ts = nullptr;
    ap = Yap_FindLUIntKey(IntegerOfTerm(t));
  } else if (IsPairTerm(t)) {
    t = Yap_MkApplTerm(FunctorCsult, 1, &t);
    goto restart;
  } else if (IsApplTerm(t)) {
    Functor fun = FunctorOfTerm(t);
    if (IsExtensionFunctor(fun)) {
      throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
                     Yap_TermToIndicator(t, tmod), pname);
    }
    if (fun == FunctorModule) {
      tmod = ArgOfTerm(1, t);
      if (IsVarTerm(tmod)) {
        throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
      }
      if (!IsAtomTerm(tmod)) {
        throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname);
      }
      t = ArgOfTerm(2, t);
      goto restart;
    }
    ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
    ts = RepAppl(t) + 1;
  } else {
    throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname);
  }
}
Exemple #17
0
static Int prompt1(USES_REGS1) { /* prompt1(Atom)                 */
  Term t = Deref(ARG1);
  Atom a;
  if (IsVarTerm(t) || !IsAtomTerm(t))
    return (FALSE);
  LOCAL_AtPrompt = a = AtomOfTerm(t);
  if (strlen((char *)RepAtom(a)->StrOfAE) > MAX_PROMPT) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, t, "prompt %s is too long",
              RepAtom(a)->StrOfAE);
    return (FALSE);
  }
  strncpy(LOCAL_Prompt, (char *)RepAtom(a)->StrOfAE, MAX_PROMPT);
  return (TRUE);
}
Exemple #18
0
const char *Yap_GetFileName(Term t USES_REGS) {
  char *buf = Malloc(YAP_FILENAME_MAX + 1);
  if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorSlash) {
    snprintf(buf, YAP_FILENAME_MAX, "%s/%s", Yap_GetFileName(ArgOfTerm(1, t)),
             Yap_GetFileName(ArgOfTerm(2, t)));
  }
  if (IsAtomTerm(t)) {
    return RepAtom(AtomOfTerm(t))->StrOfAE;
  }
  if (IsStringTerm(t)) {
    return StringOfTerm(t);
  }
  return Yap_TextTermToText(t PASS_REGS);
}
Exemple #19
0
static bool
has_encoding(int sno,
             Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage)  */
  if (!IsVarTerm(t2) && !(isatom(t2))) {
    return FALSE;
  }
  if (0 && IsAtomTerm(t2)) {
    encoding_t e = enc_id(RepAtom(AtomOfTerm(t2))->StrOfAE);
    GLOBAL_Stream[sno].encoding = e;
    return true;
  } else {
    const char *s = enc_name(LOCAL_encoding);
    return Yap_unify(t2, MkAtomTerm(Yap_LookupAtom(s)));
  }
}
Exemple #20
0
static Int check_if_valid_new_alias (USES_REGS1)
{
  Term tname = Deref(ARG1);
  Atom at;

  if (IsVarTerm(tname)) {
    Yap_Error(INSTANTIATION_ERROR, tname, "$add_alias_to_stream");
    return (FALSE);
  } else if (!IsAtomTerm (tname)) {
    Yap_Error(TYPE_ERROR_ATOM, tname, "$add_alias_to_stream");
    return (FALSE);
  }
  at = AtomOfTerm(tname);
  return(Yap_CheckAlias(at) == -1);
}
Exemple #21
0
static Int 
p_binary_is(void)
{				/* X is Y	 */
  Term t = Deref(ARG2);
  Term t1, t2;

  if (IsVarTerm(t)) {
    Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
    return(FALSE);
  }
  t1 = Yap_Eval(Deref(ARG3));
  if (!Yap_FoundArithError(t1, ARG3)) {
    return FALSE;
  }
  t2 = Yap_Eval(Deref(ARG4));
  if (!Yap_FoundArithError(t2, ARG4)) {
    return FALSE;
  }
  if (IsIntTerm(t)) {
    Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
    if (!tout)
      return FALSE;
    return Yap_unify_constant(ARG1,tout);
  }
  if (IsAtomTerm(t)) {
    Atom name = AtomOfTerm(t);
    ExpEntry *p;
    Term out;

    if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
      Term ti[2];

      /* error */
      ti[0] = t;
      ti[1] = MkIntTerm(1);
      t = Yap_MkApplTerm(FunctorSlash, 2, ti);
      Yap_Error(TYPE_ERROR_EVALUABLE, t,
		"functor %s/%d for arithmetic expression",
		RepAtom(name)->StrOfAE,2);
      P = FAILCODE;
      return(FALSE);
    }
    if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
      return FALSE;
    return Yap_unify_constant(ARG1,out);
  }
  return FALSE;
}
Exemple #22
0
bool YAP_is_blob(Term t, blob_type_t **type) {
  CACHE_REGS
  Term yt = Yap_GetFromSlot(t);
  Atom a;
  YAP_BlobPropEntry *b;

  if (IsVarTerm(yt))
    return FALSE;
  if (!IsAtomTerm(yt))
    return FALSE;
  a = AtomOfTerm(yt);
  if (!IsBlob(a))
    return FALSE;
  b = RepBlobProp(a->PropsOfAE);
  *type = b->blob_type;
  return TRUE;
}
Exemple #23
0
/** @pred prompt(- _A_,+ _B_)

Changes YAP input prompt from  _A_ to  _B_, active on *next* standard input
interaction.

*/
static Int prompt(USES_REGS1) { /* prompt(Old,New)       */
  Term t = Deref(ARG2);
  Atom a;
  if (!Yap_unify_constant(ARG1, MkAtomTerm(LOCAL_AtPrompt)))
    return (FALSE);
  if (IsVarTerm(t) || !IsAtomTerm(t))
    return (FALSE);
  a = AtomOfTerm(t);
  if (strlen(RepAtom(a)->StrOfAE) > MAX_PROMPT) {
    Yap_Error(SYSTEM_ERROR_INTERNAL, t, "prompt %s is too long",
              RepAtom(a)->StrOfAE);
    return false;
  }
  strncpy(LOCAL_Prompt, (char *)RepAtom(LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
  LOCAL_AtPrompt = a;
  return (TRUE);
}
Exemple #24
0
static void
mark_registers(void)
{
  CELL *pt;

  pt = XREGS;
  /* moving the trail is simple */
  while (pt != XREGS+MaxTemps) {
    CELL reg = *pt++;

    if (!IsVarTerm(reg)) {
      if (IsAtomTerm(reg)) {
	MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
      }
    }
  }
}
Exemple #25
0
static Int
p_frequencyty1( USES_REGS1 )
{
  // this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes
  if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) {
    Term t = Deref(ARG1);
    // valid value for ARG1 is just 'atom'
    if (IsAtomTerm(t)) {
      // ARG1 is atom
      int i = 0, j = 0;
      char *tmp;
      // gets string from atom and stores it on 'str'
      char *str = (char*)malloc(YAP_AtomNameLength(AtomOfTerm(t))*sizeof(char));
      strcpy(str, AtomName(AtomOfTerm(t)));
      // Makes upper characters of 'str' (for comparison)
      UPPER_ENTRY(str);

      // Detectng frequency type according to 'str'
      if (strcmp(str, "COUNTER") == 0 || strcmp(str, "COUNT") == 0) {
        ExpEnv.config_struc.frequency_type = COUNTER; // setting frequency type to 'counter'
 	ExpEnv.config_struc.frequency_bound = 1024.0; // if 'counter', frequency bound is '1024.0'
 	return TRUE;
      }
      else if (strcmp(str, "TIME") == 0 || strcmp(str, "TIMING") == 0) {
        ExpEnv.config_struc.frequency_type = TIME; // setting frequency type to 'time'
 	ExpEnv.config_struc.frequency_bound = 0.02; // if 'time', frequency bound is '0.02'
	return TRUE;
      }
      else {
        // value passed by argument is out of known range
        Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,"");
        return FALSE;
      }
    }
    else {
      // ARG1 is not an atom
      Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"Frequency type");
      return FALSE;
    }
  }
  else {
    // current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION'
    Yap_NilError(INCOMPATIBLEMODE_WARNING,"");
    return FALSE;
  }
}
Exemple #26
0
PL_is_blob(term_t t, PL_blob_t **type)
{
  CACHE_REGS
  Term yt = Yap_GetFromSlot(t PASS_REGS);
  Atom a;
  BlobPropEntry *b;

  if (IsVarTerm(yt))
    return FALSE;
  if (!IsAtomTerm(yt))
    return FALSE;
  a = AtomOfTerm(yt);
  if (!IsBlob(a))
    return FALSE;
  b = RepBlobProp(a->PropsOfAE);
  *type = b->blob_t;
  return TRUE;
}
Exemple #27
0
static void
mark_trail(void)
{
  register tr_fr_ptr pt;

  pt = TR;
  /* moving the trail is simple */
  while (pt != (tr_fr_ptr)Yap_TrailBase) {
    CELL reg = TrailTerm(pt-1);

    if (!IsVarTerm(reg)) {
      if (IsAtomTerm(reg)) {
	MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
      }
    }

    pt--;
  }
}
Exemple #28
0
bool
Yap_FetchStreamAlias (int sno, Term t2 USES_REGS)
{

  if (IsVarTerm(t2)) {
    Atom at = FetchAlias(sno);
    if (at == NULL)
      return false;
    else {
      return Yap_unify_constant(t2, MkAtomTerm(at));
    }
  } else if (IsAtomTerm(t2)) {
    Atom at = AtomOfTerm(t2);
    return  ExistsAliasForStream(sno,at);
  } else {
     Yap_Error(TYPE_ERROR_ATOM, t2, "stream_property(_,alias( ))");
    return false;
  }
}
Exemple #29
0
static Int               /* mpe_close(+FileName) */
p_close()
{
  Term t_str = Deref(ARG1);
  char *str;

  /* The arg must be bound to an atom. */
  if (IsVarTerm(t_str)) {
    Yap_Error(INSTANTIATION_ERROR, t_str, "mpe_close");
    return (FALSE);
  } else if( !IsAtomTerm(t_str) ) {
    Yap_Error(TYPE_ERROR_ATOM, t_str, "mpe_close");
    return (FALSE);
  } else {
    str = RepAtom(AtomOfTerm(t_str))->StrOfAE;
  }

  return (MPE_Finish_log(str) == 0);
}
Exemple #30
0
YAP_tag_t YAPTerm::tag() {
  Term tt = gt();
  if (IsVarTerm(tt)) {
    CELL *pt = VarOfTerm(tt);
    if (IsUnboundVar(pt)) {
      CACHE_REGS
      if (IsAttVar(pt))
        return YAP_TAG_ATT;
      return YAP_TAG_UNBOUND;
    }
    return YAP_TAG_REF;
  }
  if (IsPairTerm(tt))
    return YAP_TAG_PAIR;
  if (IsAtomOrIntTerm(tt)) {
    if (IsAtomTerm(tt))
      return YAP_TAG_ATOM;
    return YAP_TAG_INT;
  } else {
    Functor f = FunctorOfTerm(tt);

    if (IsExtensionFunctor(f)) {
      if (f == FunctorDBRef) {
        return YAP_TAG_DBREF;
      }
      if (f == FunctorLongInt) {
        return YAP_TAG_LONG_INT;
      }
      if (f == FunctorBigInt) {
        big_blob_type bt = (big_blob_type)RepAppl(tt)[1];
        switch (bt) {
        case BIG_INT:
          return YAP_TAG_BIG_INT;
        case BIG_RATIONAL:
          return YAP_TAG_RATIONAL;
        default:
          return YAP_TAG_OPAQUE;
        }
      }
    }
    return YAP_TAG_APPL;
  }
}