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); }
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; } } }
static inline Functor FuncAdjust(Functor f) { if (!IsExtensionFunctor(f)) { AtomEntry *ae = RepAtom(NameOfFunctor(f)); MarkAtomEntry(ae); } return(f); }
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'); }
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); }
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)); }
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)); }
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); } }
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 */ }
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))); } } }
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); }
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; }
/// 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; }
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); }