Exemple #1
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 #2
0
static void
LookupFunctor(Functor fun)
{
  CACHE_REGS
  CELL hash = ((CELL)(fun))/(2*sizeof(CELL)) % LOCAL_ExportFunctorHashTableSize;
  export_functor_hash_entry_t *f;
  Atom name = NameOfFunctor(fun);
  UInt arity  = ArityOfFunctor(fun);

  f = LOCAL_ExportFunctorHashChain+hash;
  while (f->val) {
    if (f->val == fun) {
      return;
    }
    f++;
    if (f == LOCAL_ExportFunctorHashChain+LOCAL_ExportFunctorHashTableSize)
      f = LOCAL_ExportFunctorHashChain;
  }
  LookupAtom(name);
  f->val = fun;
  f->name = name;
  f->arity = arity;
  LOCAL_ExportFunctorHashTableNum++;
  if (LOCAL_ExportFunctorHashTableNum >
      LOCAL_ExportFunctorHashTableSize/2
      ) {
    GrowFunctorTable();
    if (!LOCAL_ExportFunctorHashChain) {
      return;
    }
  }
}
Exemple #3
0
static inline Functor
FuncAdjust(Functor f)
{
  if (!IsExtensionFunctor(f)) {  
    AtomEntry *ae = RepAtom(NameOfFunctor(f));
    MarkAtomEntry(ae);
  }
  return(f);
}
Exemple #4
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(LOCAL_c_error_stream,' ');
#endif
    Yap_DebugPutc(LOCAL_c_error_stream,'>');
    Yap_DebugPutc(LOCAL_c_error_stream,'\t');
    Yap_DebugPlWrite(tmod);
    Yap_DebugPutc(LOCAL_c_error_stream,':');
    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(LOCAL_c_error_stream,'/');
	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(LOCAL_c_error_stream,'/');
	Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
      }
    }
    Yap_DebugPutc(LOCAL_c_error_stream,'\n');
}
Exemple #5
0
static Term
get_matrix_element(Term t1, Term t2 USES_REGS)
{
  if (!IsPairTerm(t2)) {
    if (t2 == MkAtomTerm(AtomLength)) {
      Int sz = 1;
      while (IsApplTerm(t1)) {
	Functor f = FunctorOfTerm(t1);
	if (NameOfFunctor(f) != AtomNil) {
	  return MkIntegerTerm(sz);
	}
	sz *= ArityOfFunctor(f);
	t1 = ArgOfTerm(1, t1);
      }
      return MkIntegerTerm(sz);
    }
    Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
    return FALSE;      
  }
  while (IsPairTerm(t2)) {
    Int indx;
    Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
    if (!IsIntegerTerm(indxt)) {
      Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
      return FALSE;      
    }
    indx = IntegerOfTerm(indxt);
    if (!IsApplTerm(t1)) {
      Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
      return FALSE;      
    } else {
      Functor f = FunctorOfTerm(t1);
      if (ArityOfFunctor(f) < indx) {
	Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
	return FALSE;      
      }
    }
    t1 = ArgOfTerm(indx, t1);
    t2 = TailOfTerm(t2);
  }
  if (t2 != TermNil) {
    Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
    return FALSE;
  }
  return Eval(t1 PASS_REGS);
}
Exemple #6
0
Term
Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)	
     /* build compound term with functor f and n
      * args a */
{
  CACHE_REGS
  CELL           *t = HR;

  if (n == 0)
    return (MkAtomTerm(NameOfFunctor(f)));
  if (f == FunctorList)
    return MkPairTerm(a[0], a[1]);
  *HR++ = (CELL) f;
  while (n--)
    *HR++ = (CELL) * a++;
  return (AbsAppl(t));
}
Exemple #7
0
Term 
Yap_MkNewApplTerm(Functor f, unsigned int n)	
     /* build compound term with functor f and n
      * args a */
{
  CACHE_REGS
  CELL           *t = HR;

  if (n == 0)
    return (MkAtomTerm(NameOfFunctor(f)));
  if (f == FunctorList) {
    RESET_VARIABLE(HR);
    RESET_VARIABLE(HR+1);
    HR+=2;
    return (AbsPair(t));
  }
  *HR++ = (CELL) f;
  while (n--) {
    RESET_VARIABLE(HR);
    HR++;
  }
  return (AbsAppl(t));
}
Exemple #8
0
static Term
Eval(Term t USES_REGS)
{

  if (IsVarTerm(t)) {
    return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
  } else if (IsNumTerm(t)) {
    return t;
  } else if (IsAtomTerm(t)) {
    ExpEntry *p;
    Atom name  = AtomOfTerm(t);

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

      /* error */
      ti[0] = t;
      ti[1] = MkIntTerm(0);
      t = Yap_MkApplTerm(FunctorSlash, 2, ti);

      return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
			    "atom %s in arithmetic expression",
			    RepAtom(name)->StrOfAE);
    }
    return Yap_eval_atom(p->FOfEE);
  } else if (IsApplTerm(t)) {
    Functor fun = FunctorOfTerm(t);
    if (fun == FunctorString) {
      const char *s = StringOfTerm(t);
      if (s[1] == '\0')
	return MkIntegerTerm(s[0]);
      return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
			    "string in arithmetic expression");
    } else if ((Atom)fun == AtomFoundVar) {
      return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil,
			    "cyclic term in arithmetic expression");
    } else {
      Int n = ArityOfFunctor(fun);
      Atom name  = NameOfFunctor(fun);
      ExpEntry *p;
      Term t1, t2;
      
      if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
	Term ti[2];

	/* error */
	ti[0] = t;
	ti[1] = MkIntegerTerm(n);
	t = Yap_MkApplTerm(FunctorSlash, 2, ti);
	return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
			      "functor %s/%d for arithmetic expression",
			      RepAtom(name)->StrOfAE,n);
      }
      if (p->FOfEE == op_power && p->ArityOfEE == 2) {
	t2 = ArgOfTerm(2, t);
	if (IsPairTerm(t2)) {
	  return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
	}
      }
      *RepAppl(t) = (CELL)AtomFoundVar;
      t1 = Eval(ArgOfTerm(1,t) PASS_REGS);
      if (t1 == 0L) {
	*RepAppl(t) = (CELL)fun;
	return FALSE;
      }
      if (n == 1) {
	*RepAppl(t) = (CELL)fun;
	return Yap_eval_unary(p->FOfEE, t1);
      }
      t2 = Eval(ArgOfTerm(2,t) PASS_REGS);
      *RepAppl(t) = (CELL)fun;
      if (t2 == 0L)
	return FALSE;
      return Yap_eval_binary(p->FOfEE,t1,t2);
    }
  } /* else if (IsPairTerm(t)) */ {
    if (TailOfTerm(t) != TermNil) {
      return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
			    "string must contain a single character to be evaluated as an arithmetic expression");
    }
    return Eval(HeadOfTerm(t) PASS_REGS);
  }
}
Exemple #9
0
static Int p_table( USES_REGS1 ) {
  Term mod, t, list;
  PredEntry *pe;
  Atom at;
  int arity;
  tab_ent_ptr tab_ent;
#ifdef MODE_DIRECTED_TABLING
  int* mode_directed = NULL;
#endif /* MODE_DIRECTED_TABLING */
  
  mod = Deref(ARG1);
  t = Deref(ARG2);
  list = Deref(ARG3);

  if (IsAtomTerm(t)) {
    at = AtomOfTerm(t);
    pe = RepPredProp(PredPropByAtom(at, mod));
    arity = 0;
  } else if (IsApplTerm(t)) {
    at = NameOfFunctor(FunctorOfTerm(t));
    pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod));
    arity = ArityOfFunctor(FunctorOfTerm(t));
  } else
    return (FALSE);
  if (list != TermNil) {  /* non-empty list */
#ifndef MODE_DIRECTED_TABLING
    Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity);
    return(FALSE);
#else 
    /*************************************************************************************
      The mode operator declaration is reordered as follows:
         1. arguments with mode 'index'         (any number)
         2. arguments with mode 'min' and 'max' (any number, following the original order)
         3. arguments with mode 'all'           (any number)
         4. arguments with mode 'sum' or 'last' (only one of the two is allowed)
         5. arguments with mode 'first'         (any number)
    *************************************************************************************/
    int pos_index = 0;
    int pos_min_max = 0;
    int pos_all = 0;
    int pos_sum_last = 0;
    int pos_first = 0;
    int i;
    int *aux_mode_directed;

    aux_mode_directed = malloc(arity * sizeof(int));
    for (i = 0; i < arity; i++) {
      int mode = IntOfTerm(HeadOfTerm(list));
      if (mode == MODE_DIRECTED_INDEX)
        pos_index++;
      else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
        pos_min_max++;
      else if (mode == MODE_DIRECTED_ALL)
        pos_all++;
      else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) {
        if (pos_sum_last) {
          free(aux_mode_directed);
          Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity);
          return(FALSE);
        } else
          pos_sum_last = 1;
      }
      aux_mode_directed[i] = mode;
      list = TailOfTerm(list);
    }
    pos_first = pos_index + pos_min_max + pos_all + pos_sum_last;
    pos_sum_last = pos_index + pos_min_max + pos_all;
    pos_all = pos_index + pos_min_max;
    pos_min_max = pos_index;
    pos_index = 0;
    ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
    for (i = 0; i < arity; i++) {
      int aux_pos = 0;
      if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
        aux_pos = pos_index++;        
      else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX)
        aux_pos = pos_min_max++;
      else if (aux_mode_directed[i] == MODE_DIRECTED_ALL)
        aux_pos = pos_all++;                
      else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST)
        aux_pos = pos_sum_last++;        
      else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
        aux_pos = pos_first++;
      mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]);
    }
    free(aux_mode_directed);
#endif /* MODE_DIRECTED_TABLING */
  }
Exemple #10
0
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2	 */
{

  if (t1 == t2)
    return 0;
  if (IsVarTerm(t1)) {
    if (IsVarTerm(t2))
      return Signed(t1) - Signed(t2);
    return -1;
  } else if (IsVarTerm(t2)) {
    /* get rid of variables */
    return 1;
  }
  if (IsAtomOrIntTerm(t1)) {
    if (IsAtomTerm(t1)) {
      if (IsAtomTerm(t2))
        return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
      if (IsPrimitiveTerm(t2))
        return 1;
      if (IsStringTerm(t2))
        return 1;
      return -1;
    } else {
      if (IsIntTerm(t2)) {
        return IntOfTerm(t1) - IntOfTerm(t2);
      }
      if (IsApplTerm(t2)) {
        Functor fun2 = FunctorOfTerm(t2);
        switch ((CELL)fun2) {
        case double_e:
          return 1;
        case long_int_e:
          return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
        case big_int_e:
          return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
        case db_ref_e:
          return 1;
        case string_e:
          return -1;
        }
      }
      return -1;
    }
  } else if (IsPairTerm(t1)) {
    if (IsApplTerm(t2)) {
      Functor f = FunctorOfTerm(t2);
      if (IsExtensionFunctor(f))
        return 1;
      else {
        if (f != FunctorDot)
          return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
        else {
          return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
        }
      }
    }
    if (IsPairTerm(t2)) {
      return (
          compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
    } else
      return 1;
  } else {
    /* compound term */
    Functor fun1 = FunctorOfTerm(t1);

    if (IsExtensionFunctor(fun1)) {
      /* float, long, big, dbref */
      switch ((CELL)fun1) {
      case double_e: {
        if (IsFloatTerm(t2))
          return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
        if (IsRefTerm(t2))
          return 1;
        return -1;
      }
      case long_int_e: {
        if (IsIntTerm(t2))
          return LongIntOfTerm(t1) - IntOfTerm(t2);
        if (IsFloatTerm(t2)) {
          return 1;
        }
        if (IsLongIntTerm(t2))
          return LongIntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
        if (IsBigIntTerm(t2)) {
          return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2);
        }
#endif
        if (IsRefTerm(t2))
          return 1;
        return -1;
      }
#ifdef USE_GMP
      case big_int_e: {
        if (IsIntTerm(t2))
          return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
        if (IsFloatTerm(t2)) {
          return 1;
        }
        if (IsLongIntTerm(t2))
          return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2));
        if (IsBigIntTerm(t2)) {
          return Yap_gmp_tcmp_big_big(t1, t2);
        }
        if (IsRefTerm(t2))
          return 1;
        return -1;
      }
#endif
      case string_e: {
        if (IsApplTerm(t2)) {
          Functor fun2 = FunctorOfTerm(t2);
          switch ((CELL)fun2) {
          case double_e:
            return 1;
          case long_int_e:
            return 1;
#ifdef USE_GMP
          case big_int_e:
            return 1;
#endif
          case db_ref_e:
            return 1;
          case string_e:
            return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2));
          }
          return -1;
        }
        return -1;
      }
      case db_ref_e:
        if (IsRefTerm(t2))
          return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
        return -1;
      }
    }
    if (!IsApplTerm(t2)) {
      if (IsPairTerm(t2)) {
        Int out;
        Functor f = FunctorOfTerm(t1);

        if (!(out = ArityOfFunctor(f)) - 2)
          out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, ".");
        return out;
      }
      return 1;
    } else {
      Functor fun2 = FunctorOfTerm(t2);
      Int r;

      if (IsExtensionFunctor(fun2)) {
        return 1;
      }
      r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
      if (r)
        return r;
      r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2));
      if (r)
        return r;
      else
        return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
                                RepAppl(t2)));
    }
  }
}
Exemple #11
0
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
                           register CELL *pt1) {
  CACHE_REGS
  register CELL **to_visit = (CELL **)HR;
  register Int out = 0;

loop:
  while (pt0 < pt0_end) {
    register CELL d0, d1;
    ++pt0;
    ++pt1;
    d0 = Derefa(pt0);
    d1 = Derefa(pt1);
    if (IsVarTerm(d0)) {
      if (IsVarTerm(d1)) {
        out = Signed(d0) - Signed(d1);
        if (out)
          goto done;
      } else {
        out = -1;
        goto done;
      }
    } else if (IsVarTerm(d1)) {
      out = 1;
      goto done;
    } else {
      if (d0 == d1)
        continue;
      else if (IsAtomTerm(d0)) {
        if (IsAtomTerm(d1))
          out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
        else if (IsPrimitiveTerm(d1))
          out = 1;
        else
          out = -1;
        /* I know out must be != 0 */
        goto done;
      } else if (IsIntTerm(d0)) {
        if (IsIntTerm(d1))
          out = IntOfTerm(d0) - IntOfTerm(d1);
        else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = IntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
        } else if (IsBigIntTerm(d1)) {
          out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
#endif
        } else if (IsRefTerm(d1))
          out = 1;
        else
          out = -1;
        if (out != 0)
          goto done;
      } else if (IsFloatTerm(d0)) {
        if (IsFloatTerm(d1)) {
          out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
        } else if (IsRefTerm(d1)) {
          out = 1;
        } else {
          out = -1;
        }
        if (out != 0)
          goto done;
      } else if (IsStringTerm(d0)) {
        if (IsStringTerm(d1)) {
          out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1));
        } else if (IsIntTerm(d1))
          out = 1;
        else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = 1;
#ifdef USE_GMP
        } else if (IsBigIntTerm(d1)) {
          out = 1;
#endif
        } else if (IsRefTerm(d1)) {
          out = 1;
        } else {
          out = -1;
        }
        if (out != 0)
          goto done;
      } else if (IsLongIntTerm(d0)) {
        if (IsIntTerm(d1))
          out = LongIntOfTerm(d0) - IntOfTerm(d1);
        else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
        } else if (IsBigIntTerm(d1)) {
          out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
#endif
        } else if (IsRefTerm(d1)) {
          out = 1;
        } else {
          out = -1;
        }
        if (out != 0)
          goto done;
      }
#ifdef USE_GMP
      else if (IsBigIntTerm(d0)) {
        if (IsIntTerm(d1)) {
          out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1));
        } else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1));
        } else if (IsBigIntTerm(d1)) {
          out = Yap_gmp_tcmp_big_big(d0, d1);
        } else if (IsRefTerm(d1))
          out = 1;
        else
          out = -1;
        if (out != 0)
          goto done;
      }
#endif
      else if (IsPairTerm(d0)) {
        if (!IsPairTerm(d1)) {
          if (IsApplTerm(d1)) {
            Functor f = FunctorOfTerm(d1);
            if (IsExtensionFunctor(f))
              out = 1;
            else if (!(out = 2 - ArityOfFunctor(f)))
              out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
          } else
            out = 1;
          goto done;
        }
#ifdef RATIONAL_TREES
        to_visit[0] = pt0;
        to_visit[1] = pt0_end;
        to_visit[2] = pt1;
        to_visit[3] = (CELL *)*pt0;
        to_visit += 4;
        *pt0 = d1;
#else
        /* store the terms to visit */
        if (pt0 < pt0_end) {
          to_visit[0] = pt0;
          to_visit[1] = pt0_end;
          to_visit[2] = pt1;
          to_visit += 3;
        }
#endif
        pt0 = RepPair(d0) - 1;
        pt0_end = RepPair(d0) + 1;
        pt1 = RepPair(d1) - 1;
        continue;
      } else if (IsRefTerm(d0)) {
        if (IsRefTerm(d1))
          out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
        else
          out = -1;
        goto done;
      } else if (IsApplTerm(d0)) {
        register Functor f;
        register CELL *ap2, *ap3;
        if (!IsApplTerm(d1)) {
          out = 1;
          goto done;
        } else {
          /* store the terms to visit */
          Functor f2;
          ap2 = RepAppl(d0);
          ap3 = RepAppl(d1);
          f = (Functor)(*ap2);
          if (IsExtensionFunctor(f)) {
            out = 1;
            goto done;
          }
          f2 = (Functor)(*ap3);
          if (IsExtensionFunctor(f2)) {
            out = -1;
            goto done;
          }
          /* compare functors */
          if (f != (Functor)*ap3) {
            if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
              out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
            goto done;
          }
#ifdef RATIONAL_TREES
          to_visit[0] = pt0;
          to_visit[1] = pt0_end;
          to_visit[2] = pt1;
          to_visit[3] = (CELL *)*pt0;
          to_visit += 4;
          *pt0 = d1;
#else
          /* store the terms to visit */
          if (pt0 < pt0_end) {
            to_visit[0] = pt0;
            to_visit[1] = pt0_end;
            to_visit[2] = pt1;
            to_visit += 3;
          }
#endif
          d0 = ArityOfFunctor(f);
          pt0 = ap2;
          pt0_end = ap2 + d0;
          pt1 = ap3;
          continue;
        }
      }
    }
  }
  /* Do we still have compound terms to visit */
  if (to_visit > (CELL **)HR) {
#ifdef RATIONAL_TREES
    to_visit -= 4;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    pt1 = to_visit[2];
    *pt0 = (CELL)to_visit[3];
#else
    to_visit -= 3;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    pt1 = to_visit[2];
#endif
    goto loop;
  }

done:
/* failure */
#ifdef RATIONAL_TREES
  while (to_visit > (CELL **)HR) {
    to_visit -= 4;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    pt1 = to_visit[2];
    *pt0 = (CELL)to_visit[3];
  }
#endif
  return (out);
}
Exemple #12
0
xarg *
Yap_ArgListToVector (Term listl, const param_t *def, int n)
{
  CACHE_REGS
    xarg *a = calloc(  n , sizeof(xarg) );
  if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
    listl = ArgOfTerm(2,listl);
  if (!IsPairTerm(listl) && listl != TermNil) {
    if (IsVarTerm(listl) ) {
	free( a );
	LOCAL_Error_TYPE = INSTANTIATION_ERROR;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    if (IsAtomTerm(listl) ) {
      xarg *na = matchKey( AtomOfTerm(listl), a, n, def);
      if (!na) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    } else if (IsApplTerm(listl)) {
      Functor f = FunctorOfTerm( listl );
      if (IsExtensionFunctor(f)) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;    
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
      xarg *na = matchKey( NameOfFunctor( f ), a, n, def);
      if (!na) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    } else {
      free( a );
      LOCAL_Error_TYPE = TYPE_ERROR_LIST;
      LOCAL_Error_Term = listl;
      return NULL;
    }
    listl = MkPairTerm( listl, TermNil );
  }
  while (IsPairTerm(listl)) {
    Term hd = HeadOfTerm( listl );
    listl = TailOfTerm( listl );
    if (IsVarTerm(hd) || IsVarTerm(listl))  {
      LOCAL_Error_TYPE = INSTANTIATION_ERROR;
      if (IsVarTerm(hd)) {
	LOCAL_Error_Term = hd;
      } else {
	LOCAL_Error_Term = listl;
      }
      free( a );
      return NULL;
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey( AtomOfTerm( hd ), a, n, def);
      if (!na)
	return NULL;

      na->used = true;
      na->tvalue = TermNil;
      continue;
    } else if (IsApplTerm( hd )) {
      Functor f = FunctorOfTerm( hd );
      if (IsExtensionFunctor(f)) {
	LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
	LOCAL_Error_Term = hd;
	free( a );
	return NULL;    
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
	LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
	LOCAL_Error_Term = hd;
	free( a );
	return NULL;
      }
      xarg *na = matchKey( NameOfFunctor( f ), a, n, def);
      if (!na) {
        free( a );
	return NULL;
      }
      na->used = 1;
      na->tvalue = ArgOfTerm(1, hd);      
    } else {
      LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
      free( a );
      return NULL;    
    }
  }
  if (IsVarTerm(listl)) {
    LOCAL_Error_TYPE = INSTANTIATION_ERROR;
    LOCAL_Error_Term = listl;
    free( a );
    return NULL;
  } else if (listl != TermNil) {
    LOCAL_Error_TYPE = TYPE_ERROR_LIST;
    LOCAL_Error_Term = listl;
    free( a );
    return NULL;
  }
  return a;
}              
Exemple #13
0
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
xarg *
Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
{
  CACHE_REGS
    xarg *a = calloc(  n , sizeof(xarg) );
  if (!IsPairTerm(listl) && listl != TermNil) {
    if (IsVarTerm(listl) ) {
      return failed( INSTANTIATION_ERROR, listl, a);      
    }
    if (IsAtomTerm(listl) ) {
      xarg *na = matchKey2( AtomOfTerm(listl), a, n, def);
      if (!na) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
      }
    }
    if (IsApplTerm(listl)) {
      Functor f = FunctorOfTerm( listl );
      if (IsExtensionFunctor(f)) {
        return failed( TYPE_ERROR_PARAMETER, listl, a);      
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
        return failed( TYPE_ERROR_LIST, listl, a);      
      }
      xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
      if (!na) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
      }
    } else {
      return failed( TYPE_ERROR_LIST, listl, a);      
    }
    listl = MkPairTerm( listl, TermNil );
  }
  while (IsPairTerm(listl)) {
    Term hd = HeadOfTerm( listl );
    if (IsVarTerm(hd))  {
      return failed( INSTANTIATION_ERROR, hd, a);      
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey2( AtomOfTerm( hd ), a, n, def);
      if (!na) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
      }
      na->used = true;
      na->tvalue = TermNil;
      continue;
    } else if (IsApplTerm( hd )) {
      Functor f = FunctorOfTerm( hd );
      if (IsExtensionFunctor(f)) {
        return failed( TYPE_ERROR_PARAMETER, hd, a);      
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
      }
      xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
      if (na) {
	na->used = 1;
	na->tvalue = ArgOfTerm(1, hd);
      } else {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
      }
    } else {
      return failed( INSTANTIATION_ERROR, hd, a);      
    }
    listl = TailOfTerm(listl);
  }
  if (IsVarTerm(listl))  {
    return failed( INSTANTIATION_ERROR, listl, a);      
  }
  if (TermNil != listl) {
    return failed( TYPE_ERROR_LIST, listl, a);      
  }
  return a;
}		
Exemple #14
0
void
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
{
    CACHE_REGS
    char *s;
    char *mname;
    Int arity;
    /*  extern int gc_calls; */

    LOCK(Yap_heap_regs->low_level_trace_lock);
    sc = Yap_heap_regs;
    vsc_count++;
#ifdef THREADS
    LOCAL_ThreadHandle.thread_inst_count++;
#endif
#ifdef COMMENTED
    {
        choiceptr b_p = B;
        while (b_p) {
            fprintf(stderr,"%p %ld\n",b_p,Yap_op_from_opcode(b_p->cp_ap->opc));
            b_p = b_p->cp_b;
        }
    }
    {   choiceptr myB = B;
        while (myB) myB = myB->cp_b;
    }
    //*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc ||
    //0x4fd4d
    if (vsc_count == 40650191LL)
        jmp_deb(1);
    return;
    if (vsc_count > 1388060LL && vsc_count < 1388070LL) {
        if (vsc_count==1388061LL)
            jmp_deb(1);
        if (vsc_count % 1LL == 0) {
            UInt sz = Yap_regp->H0_[17];
            UInt end = sizeof(MP_INT)/sizeof(CELL)+sz+1;
            fprintf(stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]);
        }
    } else
        return;
    {
        tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase;
        if (pt[140].term == 0 && pt[140].value != 0)
            jmp_deb(1);
    }
    if (worker_id != 04 || worker_id != 03) return;
    //  if (vsc_count == 218280)
    //    vsc_xstop = 1;
    if (vsc_count < 1468068888) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (port != enter_pred ||
            !pred ||
            pred->ArityOfPE != 4 ||
            strcmp(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE,"in_between_target_phrases")) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (vsc_count < 1246949400LL) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (vsc_count == 1246949493LL)
        vsc_xstop = TRUE;
    if (vsc_count < 5646100000LL) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (vsc_count == 5646100441LL)
        vsc_xstop = TRUE;
    if (vsc_count < 2923351500LL) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (vsc_count == 123536441LL) vsc_xstop = 1;
    if (vsc_count < 5530257LL) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (vsc_count == 9414280LL) {
        vsc_xstop = TRUE;
    }
    if (vsc_count < 3399741LL) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (TR_FZ > TR)
        jmp_deb(1);
    {
        tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase;
        if (pt[153].term == 0 && pt[153].value == 0 &&
                pt[154].term != 0 && pt[154].value != 0 && ( TR > pt+154 ||
                        TR_FZ > pt+154))
            jmp_deb(2);
        if (pt[635].term == 0 && pt[635].value == 0 &&
                pt[636].term != 0 && pt[636].value != 0 && ( TR > pt+636 ||
                        TR_FZ > pt+636))
            jmp_deb(3);
        if (pt[138].term == 0 && pt[138].value == 0 &&
                pt[139].term != 0 && pt[139].value != 0 && ( TR > pt+138 ||
                        TR_FZ > pt+138) )
            jmp_deb(4);
    }
    if (vsc_count == 287939LL)
        jmp_deb(1);
    if (vsc_count == 173118LL)
        jmp_deb(1);
    if (!(vsc_count >= 287934LL && vsc_count <= 287939LL) &&
            !(vsc_count >= 173100LL && vsc_count <= 173239LL) &&
            vsc_count != -1)
        return;
    if (vsc_count == 51021) {
        printf("Here I go\n");
    }
    if (vsc_count < 52000) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (vsc_count > 52000) exit(0);
    UNLOCK(Yap_heap_regs->low_level_trace_lock);
    return;
    if (vsc_count == 837074) {
        printf("Here I go\n");
    }
    if (gc_calls < 1) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    {
        CELL *env_ptr = ENV;
        PredEntry *p;

        while (env_ptr) {
            PredEntry *pe = EnvPreg(env_ptr[E_CP]);

            printf("%p->",env_ptr,pe);
            if (vsc_count == 52LL) printf("\n");
            if (p == pe) {
                UNLOCK(Yap_heap_regs->low_level_trace_lock);
                return;
            }
            if (env_ptr != NULL)
                env_ptr = (CELL *)(env_ptr[E_E]);
        }
        printf("\n");
    }
#endif
    fprintf(GLOBAL_stderr,"%lld ",vsc_count);
#if defined(THREADS) || defined(YAPOR)
    fprintf(GLOBAL_stderr,"(%d)", worker_id);
#endif
    /* check_trail_consistency(); */
    if (pred == NULL) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    if (pred->ModuleOfPred == 0 && !LOCAL_do_trace_primitives) {
        UNLOCK(Yap_heap_regs->low_level_trace_lock);
        return;
    }
    switch (port) {
    case enter_pred:
        mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
        arity = pred->ArityOfPE;
        if (arity == 0)
            s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
        else
            s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
        /*    if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
          return;       */
        send_tracer_message("CALL: ", s, arity, mname, args);
        break;
    case try_or:
        send_tracer_message("TRY_OR ", NULL, 0, NULL, args);
        break;
    case retry_or:
        send_tracer_message("FAIL ", NULL, 0, NULL, args);
        send_tracer_message("RETRY_OR ", NULL, 0, NULL, args);
        break;
    case retry_table_generator:
        send_tracer_message("FAIL ", NULL, 0, NULL, args);
        mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
        arity = pred->ArityOfPE;
        if (arity == 0)
            s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
        else
            s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
        send_tracer_message("RETRY GENERATOR: ", s, arity, mname, args);
        break;
    case retry_table_consumer:
        send_tracer_message("FAIL ", NULL, 0, NULL, args);
        mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
        arity = pred->ArityOfPE;
        if (arity == 0) {
            s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
            send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
        } else {
            s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
            send_tracer_message("RETRY CONSUMER: ", s, pred->ArityOfPE, mname, NULL);
        }
        break;
    case retry_table_loader:
        send_tracer_message("FAIL ", NULL, 0, NULL, args);
        if (pred == UndefCode) {
            send_tracer_message("RETRY LOADER ", NULL, 0, NULL, NULL);
        } else {
            mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
            arity = pred->ArityOfPE;
            if (arity == 0)
                s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
            else
                s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
            send_tracer_message("RETRY LOADER: ", s, 0, mname, NULL);
        }
        break;
    case retry_pred:
        send_tracer_message("FAIL ", NULL, 0, NULL, args);
        if (pred != NULL) {
            mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
            arity = pred->ArityOfPE;
            if (pred->ModuleOfPred == IDB_MODULE) {
                s = "recorded";
                arity = 3;
            } else if (arity == 0) {
                s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
            } else {
                s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
            }
            send_tracer_message("RETRY: ", s, arity, mname, args);
        }
        break;
    }
    fflush(NULL);
    UNLOCK(Yap_heap_regs->low_level_trace_lock);
}