diff --git a/C/absmi.c b/C/absmi.c index 6b208d8d0..5094a2835 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -5855,7 +5855,7 @@ absmi(int inp) saveregs(); save_machine_regs(); - SREG = (CELL *) YapExecute(p, (CPredicate)(p->TrueCodeOfPred)); + SREG = (CELL *) YAP_Execute(p, (CPredicate)(p->TrueCodeOfPred)); EX = 0L; } @@ -5984,7 +5984,7 @@ absmi(int inp) ASP = YENV; saveregs(); save_machine_regs(); - SREG = (CELL *) YapExecute(PREG->u.lds.p, (CPredicate)(PREG->u.lds.d)); + SREG = (CELL *) YAP_Execute(PREG->u.lds.p, (CPredicate)(PREG->u.lds.d)); EX = 0L; restore_machine_regs(); setregs(); diff --git a/C/c_interface.c b/C/c_interface.c index e5580deaa..223d44300 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -39,85 +39,87 @@ #define X_API #endif -X_API Term STD_PROTO(YapA,(int)); -X_API Term STD_PROTO(YapMkVarTerm,(void)); -X_API Bool STD_PROTO(YapIsVarTerm,(Term)); -X_API Bool STD_PROTO(YapIsNonVarTerm,(Term)); -X_API Bool STD_PROTO(YapIsIntTerm,(Term)); -X_API Bool STD_PROTO(YapIsFloatTerm,(Term)); -X_API Bool STD_PROTO(YapIsDbRefTerm,(Term)); -X_API Bool STD_PROTO(YapIsAtomTerm,(Term)); -X_API Bool STD_PROTO(YapIsPairTerm,(Term)); -X_API Bool STD_PROTO(YapIsApplTerm,(Term)); -X_API Term STD_PROTO(YapMkIntTerm,(Int)); -X_API Int STD_PROTO(YapIntOfTerm,(Term)); -X_API Term STD_PROTO(YapMkFloatTerm,(flt)); -X_API flt STD_PROTO(YapFloatOfTerm,(Term)); -X_API Term STD_PROTO(YapMkAtomTerm,(Atom)); -X_API Atom STD_PROTO(YapAtomOfTerm,(Term)); -X_API Atom STD_PROTO(YapLookupAtom,(char *)); -X_API Atom STD_PROTO(YapFullLookupAtom,(char *)); -X_API char *STD_PROTO(YapAtomName,(Atom)); -X_API Term STD_PROTO(YapMkPairTerm,(Term,Term)); -X_API Term STD_PROTO(YapMkNewPairTerm,(void)); -X_API Term STD_PROTO(YapHeadOfTerm,(Term)); -X_API Term STD_PROTO(YapTailOfTerm,(Term)); -X_API Term STD_PROTO(YapMkApplTerm,(Functor,unsigned int,Term *)); -X_API Term STD_PROTO(YapMkNewApplTerm,(Functor,unsigned int)); -X_API Functor STD_PROTO(YapFunctorOfTerm,(Term)); -X_API Term STD_PROTO(YapArgOfTerm,(Int,Term)); -X_API Functor STD_PROTO(YapMkFunctor,(Atom,Int)); -X_API Atom STD_PROTO(YapNameOfFunctor,(Functor)); -X_API Int STD_PROTO(YapArityOfFunctor,(Functor)); -X_API void *STD_PROTO(YapExtraSpace,(void)); -X_API Int STD_PROTO(Yapcut_fail,(void)); -X_API Int STD_PROTO(Yapcut_succeed,(void)); -X_API Int STD_PROTO(YapUnify,(Term,Term)); -X_API Int STD_PROTO(YapUnify,(Term,Term)); -X_API int STD_PROTO(YapReset,(void)); -X_API Int STD_PROTO(YapInit,(yap_init_args *)); -X_API Int STD_PROTO(YapFastInit,(char *)); -X_API Int STD_PROTO(YapCallProlog,(Term)); -X_API void *STD_PROTO(YapAllocSpaceFromYap,(unsigned int)); -X_API void STD_PROTO(YapFreeSpaceFromYap,(void *)); -X_API int STD_PROTO(YapStringToBuffer, (Term, char *, unsigned int)); -X_API Term STD_PROTO(YapBufferToString, (char *)); -X_API Term STD_PROTO(YapBufferToAtomList, (char *)); -X_API void STD_PROTO(YapError,(char *)); -X_API int STD_PROTO(YapRunGoal,(Term)); -X_API int STD_PROTO(YapRestartGoal,(void)); -X_API int STD_PROTO(YapGoalHasException,(Term *)); -X_API int STD_PROTO(YapContinueGoal,(void)); -X_API void STD_PROTO(YapPruneGoal,(void)); -X_API void STD_PROTO(YapInitConsult,(int, char *)); -X_API void STD_PROTO(YapEndConsult,(void)); -X_API Term STD_PROTO(YapRead, (int (*)(void))); -X_API void STD_PROTO(YapWrite, (Term, void (*)(int), int)); -X_API char *STD_PROTO(YapCompileClause, (Term)); -X_API void STD_PROTO(YapPutValue, (Atom,Term)); -X_API Term STD_PROTO(YapGetValue, (Atom)); -X_API int STD_PROTO(YapReset, (void)); -X_API void STD_PROTO(YapExit, (int)); -X_API void STD_PROTO(YapInitSocks, (char *, long)); -X_API void STD_PROTO(YapSetOutputMessage, (void)); -X_API int STD_PROTO(YapStreamToFileNo, (Term)); -X_API void STD_PROTO(YapCloseAllOpenStreams,(void)); -X_API Term STD_PROTO(YapOpenStream,(void *, char *, Term, int)); -X_API long STD_PROTO(YapNewSlots,(int)); -X_API long STD_PROTO(YapInitSlot,(Term)); -X_API Term STD_PROTO(YapGetFromSlot,(long)); -X_API Term *STD_PROTO(YapAddressFromSlot,(long)); -X_API void STD_PROTO(YapPutInSlot,(long, Term)); -X_API void STD_PROTO(YapRecoverSlots,(int)); -X_API void STD_PROTO(YapThrow,(Term)); -X_API int STD_PROTO(YapLookupModule,(Term)); -X_API Term STD_PROTO(YapModuleName,(int)); -X_API void STD_PROTO(YapHalt,(int)); -X_API Term *STD_PROTO(YapTopOfLocalStack,(void)); -X_API void *STD_PROTO(YapPredicate,(Atom,Int,Int)); -X_API void STD_PROTO(YapPredicateInfo,(void *,Atom *,Int *,Int *)); -X_API void STD_PROTO(YapUserCPredicateWithArgs,(char *,CPredicate,Int,Int)); -X_API Int STD_PROTO(YapCurrentModule,(void)); +X_API Term STD_PROTO(YAP_A,(int)); +X_API Term STD_PROTO(YAP_MkVarTerm,(void)); +X_API Bool STD_PROTO(YAP_IsVarTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsNonVarTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsIntTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsFloatTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsDbRefTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsAtomTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsPairTerm,(Term)); +X_API Bool STD_PROTO(YAP_IsApplTerm,(Term)); +X_API Term STD_PROTO(YAP_MkIntTerm,(Int)); +X_API Int STD_PROTO(YAP_IntOfTerm,(Term)); +X_API Term STD_PROTO(YAP_MkFloatTerm,(flt)); +X_API flt STD_PROTO(YAP_FloatOfTerm,(Term)); +X_API Term STD_PROTO(YAP_MkAtomTerm,(Atom)); +X_API Atom STD_PROTO(YAP_AtomOfTerm,(Term)); +X_API Atom STD_PROTO(YAP_LookupAtom,(char *)); +X_API Atom STD_PROTO(YAP_FullLookupAtom,(char *)); +X_API char *STD_PROTO(YAP_AtomName,(Atom)); +X_API Term STD_PROTO(YAP_MkPairTerm,(Term,Term)); +X_API Term STD_PROTO(YAP_MkNewPairTerm,(void)); +X_API Term STD_PROTO(YAP_HeadOfTerm,(Term)); +X_API Term STD_PROTO(YAP_TailOfTerm,(Term)); +X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,unsigned long int,Term *)); +X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,unsigned long int)); +X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term)); +X_API Term STD_PROTO(YAP_ArgOfTerm,(Int,Term)); +X_API Functor STD_PROTO(YAP_MkFunctor,(Atom,Int)); +X_API Atom STD_PROTO(YAP_NameOfFunctor,(Functor)); +X_API Int STD_PROTO(YAP_ArityOfFunctor,(Functor)); +X_API void *STD_PROTO(YAP_ExtraSpace,(void)); +X_API Int STD_PROTO(YAP_cut_fail,(void)); +X_API Int STD_PROTO(YAP_cut_succeed,(void)); +X_API Int STD_PROTO(YAP_Unify,(Term,Term)); +X_API Int STD_PROTO(YAP_Unify,(Term,Term)); +X_API int STD_PROTO(YAP_Reset,(void)); +X_API Int STD_PROTO(YAP_Init,(YAP_init_args *)); +X_API Int STD_PROTO(YAP_FastInit,(char *)); +X_API Int STD_PROTO(YAP_CallProlog,(Term)); +X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int)); +X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *)); +X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int)); +X_API Term STD_PROTO(YAP_BufferToString, (char *)); +X_API Term STD_PROTO(YAP_BufferToAtomList, (char *)); +X_API void STD_PROTO(YAP_Error,(char *)); +X_API int STD_PROTO(YAP_RunGoal,(Term)); +X_API int STD_PROTO(YAP_RestartGoal,(void)); +X_API int STD_PROTO(YAP_GoalHasException,(Term *)); +X_API int STD_PROTO(YAP_ContinueGoal,(void)); +X_API void STD_PROTO(YAP_PruneGoal,(void)); +X_API void STD_PROTO(YAP_InitConsult,(int, char *)); +X_API void STD_PROTO(YAP_EndConsult,(void)); +X_API Term STD_PROTO(YAP_Read, (int (*)(void))); +X_API void STD_PROTO(YAP_Write, (Term, void (*)(int), int)); +X_API char *STD_PROTO(YAP_CompileClause, (Term)); +X_API void STD_PROTO(YAP_PutValue, (Atom,Term)); +X_API Term STD_PROTO(YAP_GetValue, (Atom)); +X_API int STD_PROTO(YAP_Reset, (void)); +X_API void STD_PROTO(YAP_Exit, (int)); +X_API void STD_PROTO(YAP_InitSocks, (char *, long)); +X_API void STD_PROTO(YAP_SetOutputMessage, (void)); +X_API int STD_PROTO(YAP_StreamToFileNo, (Term)); +X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void)); +X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int)); +X_API long STD_PROTO(YAP_NewSlots,(int)); +X_API long STD_PROTO(YAP_InitSlot,(Term)); +X_API Term STD_PROTO(YAP_GetFromSlot,(long)); +X_API Term *STD_PROTO(YAP_AddressFromSlot,(long)); +X_API void STD_PROTO(YAP_PutInSlot,(long, Term)); +X_API void STD_PROTO(YAP_RecoverSlots,(int)); +X_API void STD_PROTO(YAP_Throw,(Term)); +X_API int STD_PROTO(YAP_LookupModule,(Term)); +X_API Term STD_PROTO(YAP_ModuleName,(int)); +X_API void STD_PROTO(YAP_Halt,(int)); +X_API Term *STD_PROTO(YAP_TopOfLocalStack,(void)); +X_API void *STD_PROTO(YAP_Predicate,(Atom,unsigned long int,int)); +X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,int *)); +X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int)); +X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int)); +X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,int)); +X_API Int STD_PROTO(YAP_CurrentModule,(void)); static int (*do_getf)(void); @@ -133,63 +135,62 @@ static int do_yap_putc(int streamno,int ch) { } X_API Term -YapA(int i) +YAP_A(int i) { - return(Deref(XREGS[i])); } X_API Bool -YapIsIntTerm(Term t) +YAP_IsIntTerm(Term t) { return (IsIntegerTerm(t)); } X_API Bool -YapIsVarTerm(Term t) +YAP_IsVarTerm(Term t) { return (IsVarTerm(t)); } X_API Bool -YapIsNonVarTerm(Term t) +YAP_IsNonVarTerm(Term t) { return (IsNonVarTerm(t)); } X_API Bool -YapIsFloatTerm(Term t) +YAP_IsFloatTerm(Term t) { return (IsFloatTerm(t)); } X_API Bool -YapIsDbRefTerm(Term t) +YAP_IsDbRefTerm(Term t) { return (IsDBRefTerm(t)); } X_API Bool -YapIsAtomTerm(Term t) +YAP_IsAtomTerm(Term t) { return (IsAtomTerm(t)); } X_API Bool -YapIsPairTerm(Term t) +YAP_IsPairTerm(Term t) { return (IsPairTerm(t)); } X_API Bool -YapIsApplTerm(Term t) +YAP_IsApplTerm(Term t) { return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))); } X_API Term -YapMkIntTerm(Int n) +YAP_MkIntTerm(Int n) { Term I; BACKUP_H(); @@ -200,7 +201,7 @@ YapMkIntTerm(Int n) } X_API Int -YapIntOfTerm(Term t) +YAP_IntOfTerm(Term t) { if (!IsApplTerm(t)) return (IntOfTerm(t)); @@ -209,7 +210,7 @@ YapIntOfTerm(Term t) } X_API Term -YapMkFloatTerm(double n) +YAP_MkFloatTerm(double n) { Term t; BACKUP_H(); @@ -221,13 +222,13 @@ YapMkFloatTerm(double n) } X_API flt -YapFloatOfTerm(Term t) +YAP_FloatOfTerm(Term t) { return (FloatOfTerm(t)); } X_API Term -YapMkAtomTerm(Atom n) +YAP_MkAtomTerm(Atom n) { Term t; @@ -236,14 +237,14 @@ YapMkAtomTerm(Atom n) } X_API Atom -YapAtomOfTerm(Term t) +YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); } X_API char * -YapAtomName(Atom a) +YAP_AtomName(Atom a) { char *o; @@ -252,13 +253,13 @@ YapAtomName(Atom a) } X_API Atom -YapLookupAtom(char *c) +YAP_LookupAtom(char *c) { return(LookupAtom(c)); } X_API Atom -YapFullLookupAtom(char *c) +YAP_FullLookupAtom(char *c) { Atom at; @@ -267,7 +268,7 @@ YapFullLookupAtom(char *c) } X_API Term -YapMkVarTerm(void) +YAP_MkVarTerm(void) { CELL t; BACKUP_H(); @@ -279,7 +280,7 @@ YapMkVarTerm(void) } X_API Term -YapMkPairTerm(Term t1, Term t2) +YAP_MkPairTerm(Term t1, Term t2) { Term t; BACKUP_H(); @@ -291,7 +292,7 @@ YapMkPairTerm(Term t1, Term t2) } X_API Term -YapMkNewPairTerm() +YAP_MkNewPairTerm() { Term t; BACKUP_H(); @@ -303,19 +304,19 @@ YapMkNewPairTerm() } X_API Term -YapHeadOfTerm(Term t) +YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); } X_API Term -YapTailOfTerm(Term t) +YAP_TailOfTerm(Term t) { return (TailOfTerm(t)); } X_API Term -YapMkApplTerm(Functor f,unsigned int arity, Term args[]) +YAP_MkApplTerm(Functor f,unsigned long int arity, Term args[]) { Term t; BACKUP_H(); @@ -327,7 +328,7 @@ YapMkApplTerm(Functor f,unsigned int arity, Term args[]) } X_API Term -YapMkNewApplTerm(Functor f,unsigned int arity) +YAP_MkNewApplTerm(Functor f,unsigned long int arity) { Term t; BACKUP_H(); @@ -339,14 +340,14 @@ YapMkNewApplTerm(Functor f,unsigned int arity) } X_API Functor -YapFunctorOfTerm(Term t) +YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); } X_API Term -YapArgOfTerm(Int n, Term t) +YAP_ArgOfTerm(Int n, Term t) { return (ArgOfTerm(n, t)); } @@ -354,25 +355,25 @@ YapArgOfTerm(Int n, Term t) X_API Functor -YapMkFunctor(Atom a, Int n) +YAP_MkFunctor(Atom a, Int n) { return (MkFunctor(a, n)); } X_API Atom -YapNameOfFunctor(Functor f) +YAP_NameOfFunctor(Functor f) { return (NameOfFunctor(f)); } X_API Int -YapArityOfFunctor(Functor f) +YAP_ArityOfFunctor(Functor f) { return (ArityOfFunctor(f)); } X_API void * -YapExtraSpace(void) +YAP_ExtraSpace(void) { void *ptr; BACKUP_B(); @@ -385,7 +386,7 @@ YapExtraSpace(void) } X_API Int -Yapcut_fail(void) +YAP_cut_fail(void) { BACKUP_B(); @@ -397,7 +398,7 @@ Yapcut_fail(void) } X_API Int -Yapcut_succeed(void) +YAP_cut_succeed(void) { BACKUP_B(); @@ -409,7 +410,7 @@ Yapcut_succeed(void) } X_API Int -YapUnify(Term t1, Term t2) +YAP_Unify(Term t1, Term t2) { Int out; BACKUP_MACHINE_REGS(); @@ -421,7 +422,7 @@ YapUnify(Term t1, Term t2) } X_API long -YapNewSlots(int n) +YAP_NewSlots(int n) { Int old_slots = IntOfTerm(ASP[0]), oldn = n; while (n > 0) { @@ -434,7 +435,7 @@ YapNewSlots(int n) } X_API long -YapInitSlot(Term t) +YAP_InitSlot(Term t) { Int old_slots = IntOfTerm(ASP[0]); *ASP = t; @@ -444,7 +445,7 @@ YapInitSlot(Term t) } X_API void -YapRecoverSlots(int n) +YAP_RecoverSlots(int n) { Int old_slots = IntOfTerm(ASP[0]); ASP += n; @@ -452,19 +453,19 @@ YapRecoverSlots(int n) } X_API Term -YapGetFromSlot(long slot) +YAP_GetFromSlot(long slot) { return(Deref(LCL0[slot])); } X_API Term * -YapAddressFromSlot(long slot) +YAP_AddressFromSlot(long slot) { return(LCL0+slot); } X_API void -YapPutInSlot(long slot, Term t) +YAP_PutInSlot(long slot, Term t) { LCL0[slot] = t; } @@ -480,7 +481,7 @@ typedef Int (*CPredicate7)(long,long,long,long,long,long,long); typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long); Int -YapExecute(PredEntry *pe, CPredicate exec_code) +YAP_Execute(PredEntry *pe, CPredicate exec_code) { if (pe->PredFlags & CArgsPredFlag) { switch (pe->ArityOfPE) { @@ -492,69 +493,70 @@ YapExecute(PredEntry *pe, CPredicate exec_code) case 1: { CPredicate1 code1 = (CPredicate1)exec_code; - return ((code1)(YapInitSlot(Deref(ARG1)))); + return ((code1)(YAP_InitSlot(Deref(ARG1)))); } case 2: { CPredicate2 code2 = (CPredicate2)exec_code; - return ((code2)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)))); + return ((code2)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)))); } case 3: { CPredicate3 code3 = (CPredicate3)exec_code; - return ((code3)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)), - YapInitSlot(Deref(ARG3)))); + return ((code3)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)), + YAP_InitSlot(Deref(ARG3)))); } case 4: { CPredicate4 code4 = (CPredicate4)exec_code; - return ((code4)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)), - YapInitSlot(Deref(ARG3)), - YapInitSlot(Deref(ARG4)))); + return ((code4)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)), + YAP_InitSlot(Deref(ARG3)), + YAP_InitSlot(Deref(ARG4)))); } case 5: { CPredicate5 code5 = (CPredicate5)exec_code; - return ((code5)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)), - YapInitSlot(Deref(ARG3)), - YapInitSlot(Deref(ARG4)),YapInitSlot(Deref(ARG5)))); + return ((code5)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)), + YAP_InitSlot(Deref(ARG3)), + YAP_InitSlot(Deref(ARG4)), + YAP_InitSlot(Deref(ARG5)))); } case 6: { CPredicate6 code6 = (CPredicate6)exec_code; - return ((code6)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)), - YapInitSlot(Deref(ARG3)), - YapInitSlot(Deref(ARG4)), - YapInitSlot(Deref(ARG5)), - YapInitSlot(Deref(ARG6)))); + return ((code6)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)), + YAP_InitSlot(Deref(ARG3)), + YAP_InitSlot(Deref(ARG4)), + YAP_InitSlot(Deref(ARG5)), + YAP_InitSlot(Deref(ARG6)))); } case 7: { CPredicate7 code7 = (CPredicate7)exec_code; - return ((code7)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)), - YapInitSlot(Deref(ARG3)), - YapInitSlot(Deref(ARG4)), - YapInitSlot(Deref(ARG5)), - YapInitSlot(Deref(ARG6)), - YapInitSlot(Deref(ARG7)))); + return ((code7)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)), + YAP_InitSlot(Deref(ARG3)), + YAP_InitSlot(Deref(ARG4)), + YAP_InitSlot(Deref(ARG5)), + YAP_InitSlot(Deref(ARG6)), + YAP_InitSlot(Deref(ARG7)))); } case 8: { CPredicate8 code8 = (CPredicate8)exec_code; - return ((code8)(YapInitSlot(Deref(ARG1)), - YapInitSlot(Deref(ARG2)), - YapInitSlot(Deref(ARG3)), - YapInitSlot(Deref(ARG4)), - YapInitSlot(Deref(ARG5)), - YapInitSlot(Deref(ARG6)), - YapInitSlot(Deref(ARG7)), - YapInitSlot(Deref(ARG8)))); + return ((code8)(YAP_InitSlot(Deref(ARG1)), + YAP_InitSlot(Deref(ARG2)), + YAP_InitSlot(Deref(ARG3)), + YAP_InitSlot(Deref(ARG4)), + YAP_InitSlot(Deref(ARG5)), + YAP_InitSlot(Deref(ARG6)), + YAP_InitSlot(Deref(ARG7)), + YAP_InitSlot(Deref(ARG8)))); } default: return(FALSE); @@ -565,7 +567,7 @@ YapExecute(PredEntry *pe, CPredicate exec_code) } X_API Int -YapCallProlog(Term t) +YAP_CallProlog(Term t) { Int out; SMALLUNSGN mod = CurrentModule; @@ -586,7 +588,7 @@ YapCallProlog(Term t) } X_API void * -YapAllocSpaceFromYap(unsigned int size) +YAP_AllocSpaceFromYap(unsigned int size) { void *ptr; BACKUP_MACHINE_REGS(); @@ -603,14 +605,14 @@ YapAllocSpaceFromYap(unsigned int size) } X_API void -YapFreeSpaceFromYap(void *ptr) +YAP_FreeSpaceFromYap(void *ptr) { FreeCodeSpace(ptr); } /* copy a string to a buffer */ X_API int -YapStringToBuffer(Term t, char *buf, unsigned int bufsize) +YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { unsigned int j = 0; @@ -652,7 +654,7 @@ YapStringToBuffer(Term t, char *buf, unsigned int bufsize) /* copy a string to a buffer */ X_API Term -YapBufferToString(char *s) +YAP_BufferToString(char *s) { Term t; BACKUP_H(); @@ -665,7 +667,7 @@ YapBufferToString(char *s) /* copy a string to a buffer */ X_API Term -YapBufferToAtomList(char *s) +YAP_BufferToAtomList(char *s) { Term t; BACKUP_H(); @@ -678,7 +680,7 @@ YapBufferToAtomList(char *s) X_API void -YapError(char *buf) +YAP_Error(char *buf) { Error(SYSTEM_ERROR,TermNil,buf); } @@ -689,7 +691,7 @@ static void myputc (int ch) } X_API int -YapRunGoal(Term t) +YAP_RunGoal(Term t) { int out; yamop *old_CP = CP; @@ -701,7 +703,8 @@ YapRunGoal(Term t) ENV = (CELL *)ENV[E_E]; CP = old_CP; } else { - B = B->cp_b; + if (B != NULL) /* restore might have destroyed B */ + B = B->cp_b; } RECOVER_MACHINE_REGS(); @@ -709,7 +712,7 @@ YapRunGoal(Term t) } X_API int -YapRestartGoal(void) +YAP_RestartGoal(void) { int out; BACKUP_MACHINE_REGS(); @@ -727,7 +730,7 @@ YapRestartGoal(void) } X_API int -YapContinueGoal(void) +YAP_ContinueGoal(void) { int out; BACKUP_MACHINE_REGS(); @@ -739,7 +742,7 @@ YapContinueGoal(void) } X_API void -YapPruneGoal(void) +YAP_PruneGoal(void) { BACKUP_B(); @@ -752,7 +755,7 @@ YapPruneGoal(void) } X_API int -YapGoalHasException(Term *t) +YAP_GoalHasException(Term *t) { int out = FALSE; BACKUP_MACHINE_REGS(); @@ -765,7 +768,7 @@ YapGoalHasException(Term *t) } X_API void -YapInitConsult(int mode, char *filename) +YAP_InitConsult(int mode, char *filename) { BACKUP_MACHINE_REGS(); @@ -778,7 +781,7 @@ YapInitConsult(int mode, char *filename) } X_API void -YapEndConsult(void) +YAP_EndConsult(void) { BACKUP_MACHINE_REGS(); @@ -788,7 +791,7 @@ YapEndConsult(void) } X_API Term -YapRead(int (*mygetc)(void)) +YAP_Read(int (*mygetc)(void)) { Term t; tr_fr_ptr old_TR; @@ -812,7 +815,7 @@ YapRead(int (*mygetc)(void)) } X_API void -YapWrite(Term t, void (*myputc)(int), int flags) +YAP_Write(Term t, void (*myputc)(int), int flags) { BACKUP_MACHINE_REGS(); @@ -823,7 +826,7 @@ YapWrite(Term t, void (*myputc)(int), int flags) } X_API char * -YapCompileClause(Term t) +YAP_CompileClause(Term t) { char *ErrorMessage; CODEADDR codeaddr; @@ -847,7 +850,7 @@ YapCompileClause(Term t) that wants to control Yap */ X_API Int -YapInit(yap_init_args *yap_init) +YAP_Init(YAP_init_args *yap_init) { int restore_result; int Trail = 0, Stack = 0, Heap = 0; @@ -952,9 +955,9 @@ YapInit(yap_init_args *yap_init) } X_API Int -YapFastInit(char saved_state[]) +YAP_FastInit(char saved_state[]) { - yap_init_args init_args; + YAP_init_args init_args; init_args.SavedState = saved_state; init_args.HeapSize = 0; @@ -970,23 +973,23 @@ YapFastInit(char saved_state[]) init_args.Argc = 0; init_args.Argv = NULL; - return(YapInit(&init_args)); + return(YAP_Init(&init_args)); } X_API void -YapPutValue(Atom at, Term t) +YAP_PutValue(Atom at, Term t) { PutValue(at, t); } X_API Term -YapGetValue(Atom at) +YAP_GetValue(Atom at) { return(GetValue(at)); } X_API int -YapReset(void) +YAP_Reset(void) { BACKUP_MACHINE_REGS(); @@ -1006,13 +1009,13 @@ YapReset(void) } X_API void -YapExit(int retval) +YAP_Exit(int retval) { exit_yap(retval); } X_API void -YapInitSocks(char *host, long port) +YAP_InitSocks(char *host, long port) { #if USE_SOCKET init_socks(host, port); @@ -1020,7 +1023,7 @@ YapInitSocks(char *host, long port) } X_API void -YapSetOutputMessage(void) +YAP_SetOutputMessage(void) { #if DEBUG output_msg = TRUE; @@ -1028,13 +1031,13 @@ YapSetOutputMessage(void) } X_API int -YapStreamToFileNo(Term t) +YAP_StreamToFileNo(Term t) { return(StreamToFileNo(t)); } X_API void -YapCloseAllOpenStreams(void) +YAP_CloseAllOpenStreams(void) { BACKUP_H(); @@ -1044,7 +1047,7 @@ YapCloseAllOpenStreams(void) } X_API Term -YapOpenStream(void *fh, char *name, Term nm, int flags) +YAP_OpenStream(void *fh, char *name, Term nm, int flags) { Term retv; @@ -1057,7 +1060,7 @@ YapOpenStream(void *fh, char *name, Term nm, int flags) } X_API void -YapThrow(Term t) +YAP_Throw(Term t) { BACKUP_MACHINE_REGS(); JumpToEnv(t); @@ -1065,31 +1068,31 @@ YapThrow(Term t) } X_API int -YapLookupModule(Term t) +YAP_LookupModule(Term t) { return(LookupModule(t)); } X_API Term -YapModuleName(int i) +YAP_ModuleName(int i) { return(ModuleName[i]); } X_API void -YapHalt(int i) +YAP_Halt(int i) { exit_yap(i); } X_API CELL * -YapTopOfLocalStack(void) +YAP_TopOfLocalStack(void) { return(ASP); } X_API void * -YapPredicate(Atom a, Int arity, Int m) +YAP_Predicate(Atom a, unsigned long int arity, int m) { if (arity == 0) { return((void *)RepPredProp(PredPropByAtom(a,m))); @@ -1100,7 +1103,7 @@ YapPredicate(Atom a, Int arity, Int m) } X_API void -YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m) +YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, int* m) { PredEntry *pd = (PredEntry *)p; if (pd->ArityOfPE) { @@ -1113,13 +1116,26 @@ YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m) *m = pd->ModuleOfPred; } +X_API void +YAP_UserCPredicate(char *name, CPredicate def, unsigned long int arity) +{ + InitCPred(name, arity, def, UserCPredFlag); +} + +X_API void +YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont, + unsigned long int arity, unsigned int extra) +{ + InitCPredBack(name, arity, extra, init, cont, UserCPredFlag); +} + X_API void -YapUserCPredicateWithArgs(char *a, CPredicate f, Int arity, Int mod) +YAP_UserCPredicateWithArgs(char *a, CPredicate f, unsigned long int arity, int mod) { PredEntry *pe; SMALLUNSGN cm = CurrentModule; CurrentModule = mod; - UserCPredicate(a,f,arity); + YAP_UserCPredicate(a,f,arity); if (arity == 0) { pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod)); } else { @@ -1131,7 +1147,8 @@ YapUserCPredicateWithArgs(char *a, CPredicate f, Int arity, Int mod) } X_API Int -YapCurrentModule(void) +YAP_CurrentModule(void) { return(CurrentModule); } + diff --git a/C/cdmgr.c b/C/cdmgr.c index 583d2adc4..0dcf040cb 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -79,9 +79,7 @@ STATIC_PROTO(Int p_call_count_info, (void)); STATIC_PROTO(Int p_call_count_set, (void)); STATIC_PROTO(Int p_call_count_reset, (void)); STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void)); -#ifdef DEBUG STATIC_PROTO(void list_all_predicates_in_use, (void)); -#endif #define PredArity(p) (p->ArityOfPE) #define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G) @@ -1929,6 +1927,56 @@ list_all_predicates_in_use(void) } #endif +Term +all_calls(void) +{ + choiceptr b_ptr = B; + CELL *env_ptr = ENV; + CELL *bp = NULL; + Term ts[3]; + Functor f = MkFunctor(AtomLocal,3); + + ts[0] = MkIntegerTerm((Int)P); + ts[1] = AbsPair(H); + /* walk the environment chain */ + while (env_ptr != NULL) { + bp = H; + H += 2; + /* notice that MkIntegerTerm may increase the Heap */ + bp[0] = MkIntegerTerm((Int)env_ptr[E_CP]); + if (H >= ASP) { + bp[1] = TermNil; + return(ts[0]); + } else { + bp[1] = AbsPair(H); + } + env_ptr = (CELL *)(env_ptr[E_E]); + } + bp[1] = TermNil; + ts[2] = AbsPair(H); + while (b_ptr != NULL) { + bp = H; + H += 2; + /* notice that MkIntegerTerm may increase the Heap */ + bp[0] = MkIntegerTerm((Int)b_ptr->cp_ap); + if (H >= ASP) { + bp[1] = TermNil; + return(ts[0]); + } else { + bp[1] = AbsPair(H); + } + b_ptr = b_ptr->cp_b; + } + bp[1] = TermNil; + return(MkApplTerm(f,3,ts)); +} + +static Int +p_current_stack(void) +{ + return(unify(ARG1,all_calls())); +} + static void mark_pred(int mark, PredEntry *pe) { @@ -2097,6 +2145,22 @@ PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) { return(0); } +static Int +p_pred_for_code(void) { + CODEADDR codeptr = (CODEADDR)IntegerOfTerm(Deref(ARG1)); + Atom at; + UInt arity; + SMALLUNSGN module; + Int cl; + + cl = PredForCode(codeptr, &at, &arity, &module); + return(unify(ARG2,MkAtomTerm(at)) && + unify(ARG3,MkIntegerTerm(arity)) && + unify(ARG4,ModuleName[module]) && + unify(ARG5,MkIntegerTerm(cl))); + return(0); +} + static Int p_is_profiled(void) { @@ -2504,5 +2568,7 @@ InitCdMgr(void) InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag); InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag); InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag); + InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag); + InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag); } diff --git a/C/errors.c b/C/errors.c index 043445093..94225ac8e 100644 --- a/C/errors.c +++ b/C/errors.c @@ -318,7 +318,7 @@ yamop * Error (yap_error_number type, Term where, char *format,...) { va_list ap; - CELL nt[2]; + CELL nt[3]; Functor fun; int serious; char *tp = tmpbuf; @@ -445,11 +445,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("array_overflow")); ti[1] = where; @@ -465,11 +460,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("array_type")); ti[1] = where; @@ -485,11 +475,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("io_mode")); ti[1] = where; @@ -505,11 +490,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("mutable")); ti[1] = where; @@ -525,11 +505,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("non_empty_list")); ti[1] = where; @@ -545,11 +520,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("not_less_than_zero")); ti[1] = where; @@ -565,11 +535,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("not_newline")); ti[1] = where; @@ -585,11 +550,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("not_zero")); ti[1] = where; @@ -605,11 +565,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("out_of_range")); ti[1] = where; @@ -625,11 +580,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("operator_priority")); ti[1] = where; @@ -645,11 +595,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("operator_specifier")); ti[1] = where; @@ -665,11 +610,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("radix")); ti[1] = where; @@ -685,11 +625,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("shift_count_overflow")); ti[1] = where; @@ -705,11 +640,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("source_sink")); ti[1] = where; @@ -725,11 +655,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("stream")); ti[1] = where; @@ -745,11 +670,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("stream_or_alias")); ti[1] = where; @@ -765,11 +685,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("stream_position")); ti[1] = where; @@ -785,11 +700,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("syntax_error_handler")); ti[1] = where; @@ -805,11 +715,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("time_out_spec")); ti[1] = where; @@ -825,11 +730,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("source_sink")); ti[1] = where; @@ -845,11 +745,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("array")); ti[1] = where; @@ -865,11 +760,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("stream")); ti[1] = where; @@ -885,11 +775,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("float_overflow")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); @@ -904,11 +789,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("int_overflow")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); @@ -923,11 +803,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("undefined")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); @@ -942,11 +817,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("float_underflow")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); @@ -961,11 +831,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("underflow")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); @@ -980,11 +845,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("zero_divisor")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); @@ -998,11 +858,6 @@ Error (yap_error_number type, Term where, char *format,...) { int i; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); nt[0] = MkAtomTerm(LookupAtom("instantiation_error")); tp = tmpbuf+i; @@ -1016,11 +871,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("access")); ti[1] = MkAtomTerm(LookupAtom("private_procedure")); @@ -1037,11 +887,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("create")); ti[1] = MkAtomTerm(LookupAtom("array")); @@ -1058,11 +903,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("create")); ti[1] = MkAtomTerm(LookupAtom("operator")); @@ -1079,11 +919,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("input")); ti[1] = MkAtomTerm(LookupAtom("binary_stream")); @@ -1100,11 +935,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("input")); ti[1] = MkAtomTerm(LookupAtom("past_end_of_stream")); @@ -1121,11 +951,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("input")); ti[1] = MkAtomTerm(LookupAtom("stream")); @@ -1142,11 +967,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("input")); ti[1] = MkAtomTerm(LookupAtom("text_stream")); @@ -1163,11 +983,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("modify")); ti[1] = MkAtomTerm(LookupAtom("static_procedure")); @@ -1184,11 +999,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("new")); ti[1] = MkAtomTerm(LookupAtom("alias")); @@ -1205,11 +1015,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("open")); ti[1] = MkAtomTerm(LookupAtom("source_sink")); @@ -1226,11 +1031,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("output")); ti[1] = MkAtomTerm(LookupAtom("binary_stream")); @@ -1247,11 +1047,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("output")); ti[1] = MkAtomTerm(LookupAtom("stream")); @@ -1268,11 +1063,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("output")); ti[1] = MkAtomTerm(LookupAtom("text_stream")); @@ -1289,11 +1079,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("reposition")); ti[1] = MkAtomTerm(LookupAtom("stream")); @@ -1310,11 +1095,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[3]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("resize")); ti[1] = MkAtomTerm(LookupAtom("array")); @@ -1331,11 +1111,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("character")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti); @@ -1350,11 +1125,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("character_code")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti); @@ -1369,11 +1139,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[1]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("max_arity")); nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti); @@ -1387,11 +1152,6 @@ Error (yap_error_number type, Term where, char *format,...) { int i; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); nt[0] = where; tp = tmpbuf+i; @@ -1404,11 +1164,6 @@ Error (yap_error_number type, Term where, char *format,...) { int i; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); nt[0] = MkAtomTerm(LookupAtom("system_error")); tp = tmpbuf+i; @@ -1422,11 +1177,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("array")); ti[1] = where; @@ -1442,11 +1192,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("atom")); ti[1] = where; @@ -1462,11 +1207,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("atomic")); ti[1] = where; @@ -1482,11 +1222,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("byte")); ti[1] = where; @@ -1502,11 +1237,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("callable")); ti[1] = where; @@ -1522,11 +1252,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("character")); ti[1] = where; @@ -1542,11 +1267,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("compound")); ti[1] = where; @@ -1562,11 +1282,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("db_reference")); ti[1] = where; @@ -1582,11 +1297,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("db_term")); ti[1] = where; @@ -1602,11 +1312,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("evaluable")); ti[1] = where; @@ -1622,11 +1327,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("float")); ti[1] = where; @@ -1642,11 +1342,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("integer")); ti[1] = where; @@ -1662,11 +1357,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("key")); ti[1] = where; @@ -1682,11 +1372,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("list")); ti[1] = where; @@ -1702,11 +1387,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("number")); ti[1] = where; @@ -1722,11 +1402,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("predicate_indicator")); ti[1] = where; @@ -1742,11 +1417,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("pointer")); ti[1] = where; @@ -1762,11 +1432,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("unsigned_byte")); ti[1] = where; @@ -1782,11 +1447,6 @@ Error (yap_error_number type, Term where, char *format,...) int i; Term ti[2]; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); ti[0] = MkAtomTerm(LookupAtom("variable")); ti[1] = where; @@ -1801,11 +1461,6 @@ Error (yap_error_number type, Term where, char *format,...) { int i; -#if HAVE_STRNCAT - strncat(tmpbuf, " in ", psize); -#else - strcat(tmpbuf, " in "); -#endif i = strlen(tmpbuf); nt[0] = MkAtomTerm(LookupAtom("system_error")); tp = tmpbuf+i; @@ -1817,9 +1472,8 @@ Error (yap_error_number type, Term where, char *format,...) if (type != PURE_ABORT) { /* This is used by some complex procedures to detect there was an error */ ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE; - detect_bug_location(tp, psize); } - nt[1] = MkAtomTerm(LookupAtom(tmpbuf)); + nt[1] = MkPairTerm(MkAtomTerm(LookupAtom(tmpbuf)), all_calls()); if (serious) { if (type == PURE_ABORT) JumpToEnv(MkAtomTerm(LookupAtom("abort"))); diff --git a/C/exec.c b/C/exec.c index 12f4ff131..ffe14e57b 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1250,36 +1250,48 @@ exec_absmi(int top) { int lval; if (top && (lval = sigsetjmp (RestartEnv, 1)) != 0) { - if (lval == 1) { /* restart */ - /* otherwise, SetDBForThrow will fail entering critical mode */ - PrologMode = UserMode; - /* find out where to cut to */ + switch(lval) { + case 1: + { /* restart */ + /* otherwise, SetDBForThrow will fail entering critical mode */ + PrologMode = UserMode; + /* find out where to cut to */ #if defined(__GNUC__) #if defined(hppa) || defined(__alpha) - /* siglongjmp resets the TR hardware register */ - restore_TR(); + /* siglongjmp resets the TR hardware register */ + restore_TR(); #endif #if defined(__alpha) - /* siglongjmp resets the H hardware register */ - restore_H(); + /* siglongjmp resets the H hardware register */ + restore_H(); #endif #endif - yap_flags[SPY_CREEP_FLAG] = 0; - CreepFlag = CalculateStackGap(); - P = (yamop *)FAILCODE; - } - if (lval == 2) { /* arithmetic exception */ - /* must be done here, otherwise siglongjmp will clobber all the registers */ - Error(YAP_matherror,TermNil,NULL); - /* reset the registers so that we don't have trash in abstract machine */ - set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1); - P = (yamop *)FAILCODE; - } - if (lval == 3) { /* saved state */ - return(FALSE); + yap_flags[SPY_CREEP_FLAG] = 0; + CreepFlag = CalculateStackGap(); + P = (yamop *)FAILCODE; + PrologMode = UserMode; + } + break; + case 2: + { + /* arithmetic exception */ + /* must be done here, otherwise siglongjmp will clobber all the registers */ + Error(YAP_matherror,TermNil,NULL); + /* reset the registers so that we don't have trash in abstract machine */ + set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1); + P = (yamop *)FAILCODE; + PrologMode = UserMode; + } + break; + case 3: + { /* saved state */ + return(FALSE); + } + default: + /* do nothing */ + PrologMode = UserMode; } } - PrologMode = UserMode; return(absmi(0)); } diff --git a/C/init.c b/C/init.c index a1e241a33..167d5d114 100644 --- a/C/init.c +++ b/C/init.c @@ -262,19 +262,6 @@ DebugGetc() #endif -void -UserCPredicate(char *name, CPredicate def, unsigned int arity) -{ - InitCPred(name, arity, def, UserCPredFlag); -} - -void -UserBackCPredicate(char *name, CPredicate init, CPredicate cont, - unsigned int arity, int extra) -{ - InitCPredBack(name, arity, extra, init, cont, UserCPredFlag); -} - int IsOpType(char *type) { int i; @@ -503,7 +490,7 @@ InitDebug(void) } void -InitCPred(char *Name, int Arity, CPredicate code, int flags) +InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags) { Atom atom = LookupAtom(Name); PredEntry *pe; @@ -540,11 +527,14 @@ InitCPred(char *Name, int Arity, CPredicate code, int flags) c_predicates[NUMBER_OF_CPREDS] = code; pe->StateOfPred = NUMBER_OF_CPREDS; NUMBER_OF_CPREDS++; + if (NUMBER_OF_CPREDS >= MAX_C_PREDS) { + Error(SYSTEM_ERROR, TermNil, "Too Many C-Predicates"); + } } } void -InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int flags) +InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, CPredicate code, int flags) { Atom atom = LookupAtom(Name); PredEntry *pe; @@ -585,7 +575,7 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f } void -InitAsmPred(char *Name, int Arity, int code, CPredicate def, int flags) +InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, int flags) { Atom atom = LookupAtom(Name); PredEntry *pe; @@ -660,7 +650,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont) void -InitCPredBack(char *Name, int Arity, int Extra, CPredicate Start, CPredicate Cont, int flags) +InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPredicate Start, CPredicate Cont, int flags) { PredEntry *pe; Atom atom = LookupAtom(Name); diff --git a/C/save.c b/C/save.c index 485a07d50..af707f4f0 100644 --- a/C/save.c +++ b/C/save.c @@ -608,9 +608,9 @@ check_header(void) get_cell(); /* now, check whether we got enough enough space to load the saved space */ - if ((hp_size = get_cell()) > Unsigned(AuxTop) - Unsigned(HeapBase)) { - Error(SYSTEM_ERROR,TermNil,"out of heap space, Yap needs %d", hp_size); - return(FAIL_RESTORE); + hp_size = get_cell(); + while (hp_size > Unsigned(AuxTop) - Unsigned(HeapBase)) { + growheap(FALSE); } if (mode == DO_EVERYTHING) { if ((lc_size = get_cell())+(gb_size=get_cell()) > Unsigned(LocalBase) - Unsigned(GlobalBase)) { diff --git a/C/stdpreds.c b/C/stdpreds.c index fdbbb30ad..a2fe10bb6 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -244,7 +244,7 @@ FindWhatCreep(toCreep) static Int p_opdec(void) -{ /* '$op'(p,type,atom) */ +{ /* '$opdec'(p,type,atom) */ /* we know the arguments are integer, atom, atom */ Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3); return (OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE, diff --git a/C/tracer.c b/C/tracer.c index 05c2e1fbe..33bf52b24 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -113,9 +113,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) vsc_count++; /* if (vsc_count < 123808900) return; */ - /* if (vsc_count == 134) { + if (vsc_count == 59) { printf("Here I go\n"); - } */ + } /* if (vsc_count > 500000) exit(0); */ /* if (gc_calls < 1) return;*/ #if defined(__GNUC__) diff --git a/H/Yapproto.h b/H/Yapproto.h index b807c9a23..0f731ccb3 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.21 2002-06-11 05:43:01 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.22 2002-09-09 17:39:36 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -104,9 +104,10 @@ void STD_PROTO(InitBBPreds,(void)); void STD_PROTO(InitBigNums,(void)); /* c_interface.c */ -Int STD_PROTO(YapExecute,(struct pred_entry *, CPredicate)); +Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate)); /* cdmgr.c */ +Term STD_PROTO(all_calls,(void)); void STD_PROTO(mark_as_fast,(Term)); void STD_PROTO(IPred,(CODEADDR sp)); Int STD_PROTO(PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *)); @@ -187,15 +188,13 @@ int STD_PROTO(DebugGetc,(void)); #endif int STD_PROTO(IsOpType,(char *)); void STD_PROTO(InitStacks,(int,int,int,int,int,int)); -void STD_PROTO(InitCPred,(char *, int, CPredicate, int)); -void STD_PROTO(InitAsmPred,(char *, int, int, CPredicate, int)); -void STD_PROTO(InitCmpPred,(char *, int, CmpPredicate, CPredicate, int)); -void STD_PROTO(InitCPredBack,(char *, int, int, CPredicate,CPredicate,int)); +void STD_PROTO(InitCPred,(char *, unsigned long int, CPredicate, int)); +void STD_PROTO(InitAsmPred,(char *, unsigned long int, int, CPredicate, int)); +void STD_PROTO(InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int)); +void STD_PROTO(InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int)); void STD_PROTO(InitYaamRegs,(void)); void STD_PROTO(ReInitWallTime, (void)); int STD_PROTO(OpDec,(int,char *,Atom)); -void STD_PROTO(UserCPredicate,(char *,CPredicate,unsigned int)); -void STD_PROTO(UserBackCPredicate,(char*,CPredicate,CPredicate,unsigned int,int)); /* iopreds.c */ void STD_PROTO(CloseStreams,(int)); diff --git a/console/yap.c b/console/yap.c index e533d2279..bd1907b93 100644 --- a/console/yap.c +++ b/console/yap.c @@ -17,7 +17,7 @@ /* static char SccsId[] = "X 4.3.3"; */ #include "config.h" -#include "c_interface.h" +#include "YapInterface.h" #if (DefTrailSpace < MinTrailSpace) #undef DefTrailSpace @@ -66,7 +66,7 @@ static int PROTO(mygetc, (void)); static void PROTO(do_bootfile, (char *)); -static void PROTO(do_top_goal,(Term)); +static void PROTO(do_top_goal,(YAP_Term)); static void PROTO(exec_top_level,(int, char *)); #ifndef LIGHT @@ -127,25 +127,25 @@ mygetc (void) } static void -do_top_goal (Term Goal) +do_top_goal (YAP_Term Goal) { #ifdef DEBUG if (output_msg) fprintf(stderr,"Entering absmi\n"); #endif /* PlPutc(0,'a'); PlPutc(0,'\n'); */ - YapRunGoal(Goal); + YAP_RunGoal(Goal); } /* do initial boot by consulting the file boot.yap */ static void do_bootfile (char *bootfilename) { - Term t; - Term term_nil = MkAtomTerm(YapLookupAtom("[]")); - Term term_end_of_file = MkAtomTerm(YapLookupAtom("end_of_file")); - Term term_true = MkAtomTerm(YapLookupAtom("true")); - Functor functor_query = MkFunctor(YapLookupAtom("?-"),1); + YAP_Term t; + YAP_Term term_nil = YAP_MkAtomTerm(YAP_LookupAtom("[]")); + YAP_Term term_end_of_file = YAP_MkAtomTerm(YAP_LookupAtom("end_of_file")); + YAP_Term term_true = YAP_MkAtomTerm(YAP_LookupAtom("true")); + YAP_Functor functor_query = YAP_MkFunctor(YAP_LookupAtom("?-"),1); fprintf(stderr,"Entering Yap\n"); @@ -158,13 +158,13 @@ do_bootfile (char *bootfilename) } /* the consult mode does not matter here, really */ /* - To be honest, YapInitConsult does not really do much, + To be honest, YAP_InitConsult does not really do much, it's here for the future. It also makes what we want to do clearer. */ - YapInitConsult(YAP_CONSULT_MODE,bootfilename); + YAP_InitConsult(YAP_CONSULT_MODE,bootfilename); while (!eof_found) { - t = YapRead(mygetc); + t = YAP_Read(mygetc); if (eof_found) { break; } @@ -173,37 +173,37 @@ do_bootfile (char *bootfilename) fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", bootfilename, yap_lineno); exit(1); } - if (IsVarTerm (t) || t == term_nil) + if (YAP_IsVarTerm (t) || t == term_nil) { continue; } else if (t == term_true) { - YapExit(0); + YAP_Exit(0); } else if (t == term_end_of_file) { break; } - else if (IsPairTerm (t)) + else if (YAP_IsPairTerm (t)) { fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n"); fprintf(stderr, "error found at line %d and pos %d", yap_lineno, fseek(bootfile,0L,SEEK_CUR)); } - else if (IsApplTerm (t) && FunctorOfTerm (t) == functor_query) + else if (YAP_IsApplTerm (t) && YAP_FunctorOfTerm (t) == functor_query) { - do_top_goal(ArgOfTerm (1, t)); + do_top_goal(YAP_ArgOfTerm (1, t)); } else { - char *ErrorMessage = YapCompileClause(t); + char *ErrorMessage = YAP_CompileClause(t); if (ErrorMessage) fprintf(stderr, ErrorMessage); } /* do backtrack */ - YapReset(); + YAP_Reset(); } - YapEndConsult(); + YAP_EndConsult(); fclose (bootfile); #ifdef DEBUG if (output_msg) @@ -215,7 +215,7 @@ static char *filename; static void -print_usage(const yap_init_args *init_args) +print_usage(const YAP_init_args *init_args) { fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n"); fprintf(stderr," -? Shows this screen\n"); @@ -246,7 +246,7 @@ print_usage(const yap_init_args *init_args) */ static int -parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args) +parse_yap_arguments(int argc, char *argv[], YAP_init_args *init_args) { char *p; int BootMode = YAP_BOOT_FROM_SAVED_CODE; @@ -280,15 +280,15 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args) host = *++argv; argc--; if (host != NULL && host[0] == '-') - YapError("sockets must receive host to connect to"); + YAP_Error("sockets must receive host to connect to"); p1 = *++argv; argc--; if (p1[0] == '-') - YapError("sockets must receive port to connect to"); + YAP_Error("sockets must receive port to connect to"); port = strtol(p1, &ptr, 10); if (ptr == NULL || ptr[0] != '\0') - YapError("port argument to socket must be a number"); - YapInitSocks(host,port); + YAP_Error("port argument to socket must be a number"); + YAP_InitSocks(host,port); } break; #endif @@ -355,14 +355,14 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args) if (ch) { fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]); - YapExit(1); + YAP_Exit(1); } *ssize = i; } break; #ifdef DEBUG case 'p': - YapSetOutputMessage(); + YAP_SetOutputMessage(); output_msg = TRUE; break; #endif @@ -420,7 +420,7 @@ static int init_standard_system(int argc, char *argv[]) { int BootMode; - yap_init_args init_args; + YAP_init_args init_args; init_args.SavedState = NULL; init_args.HeapSize = 0; @@ -442,7 +442,7 @@ init_standard_system(int argc, char *argv[]) if (BootMode == YAP_BOOT_FROM_PROLOG) { - YapInit(&init_args); + YAP_Init(&init_args); } else @@ -452,7 +452,7 @@ init_standard_system(int argc, char *argv[]) else init_args.SavedState = filename; - BootMode = YapInit(&init_args); + BootMode = YAP_Init(&init_args); } @@ -464,34 +464,34 @@ init_standard_system(int argc, char *argv[]) static void exec_top_level(int BootMode, char *filename) { - Term atomfalse; - Atom livegoal; + YAP_Term atomfalse; + YAP_Atom livegoal; if (BootMode == YAP_BOOT_FROM_SAVED_STACKS) { /* continue executing from the frozen stacks */ - YapContinueGoal(); + YAP_ContinueGoal(); } else if (BootMode == YAP_BOOT_FROM_PROLOG) { - Atom livegoal; + YAP_Atom livegoal; /* read the bootfile */ do_bootfile (filename ? filename : BootFile); - livegoal = FullLookupAtom("$live"); + livegoal = YAP_FullLookupAtom("$live"); /* initialise the top-level */ - YapPutValue(livegoal, MkAtomTerm (LookupAtom("true"))); + YAP_PutValue(livegoal, YAP_MkAtomTerm (YAP_LookupAtom("true"))); } /* the top-level is now ready */ /* read it before case someone, that is, Ashwin, hides the atom false away ;-). */ - livegoal = FullLookupAtom("$live"); - atomfalse = MkAtomTerm (LookupAtom("false")); - while (YapGetValue (livegoal) != atomfalse) { - do_top_goal (MkAtomTerm (livegoal)); + livegoal = YAP_FullLookupAtom("$live"); + atomfalse = YAP_MkAtomTerm (YAP_LookupAtom("false")); + while (YAP_GetValue (livegoal) != atomfalse) { + do_top_goal (YAP_MkAtomTerm (livegoal)); } - YapExit(EXIT_SUCCESS); + YAP_Exit(EXIT_SUCCESS); } #ifdef LIGHT diff --git a/docs/yap.tex b/docs/yap.tex index 1a70de6b2..6030c81ed 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -736,7 +736,7 @@ DLL project, initially empty. Notice that either the project is named yapdll or you must replace the preprocessor's variable @var{YAPDLL_EXPORTS} to match your project names -in the files @code{c_interface.h} and @code{c_interface.c}. +in the files @code{YapInterface.h} and @code{c_interface.c}. @item add all .c files in the @var{$YAPSRC/C} directory and in the @var{$YAPSRC\OPTYap} directory to the Project's @code{Source Files} (use @@ -5806,7 +5806,7 @@ Notice that we first compile the looping predicate @code{l/0} with exception when @code{l/0} performs more than 10000 reductions. -@node Arrays, Preds, Profiling , Top +@node Arrays, Preds, Call Countingf , Top @section Arrays The YAP system includes experimental support for arrays. The @@ -12465,18 +12465,18 @@ C-code described below. @example @cartouche -#include "../c_interface.h" +#include "Yap/YapInterface.h" static int my_process_id(void) @{ - Term pid = MkIntTerm(getpid()); - Term out = ARG1; - return(unify(out,pid)); + YAP_Term pid = YAP_MkIntTerm(getpid()); + YAP_Term out = YAP_ARG1; + return(YAP_Unify(out,pid)); @} void init_my_predicates() @{ - UserCPredicate("my_process_id",my_process_id,1); + YAP_UserCPredicate("my_process_id",my_process_id,1); @} @end cartouche @end example @@ -12541,18 +12541,18 @@ desired predicate. Note that it returns an integer denoting the success of failure of the goal and also that it has no arguments even though the predicate being defined has one. In fact the arguments of a prolog predicate written in C are accessed -through macros, defined in the include file, with names @var{ARG1}, -@var{ARG2}, ..., @var{ARG16} or with @var{ARG}(@var{N}) where @var{N} is -the argument number (starting with 1). In the present case the function -uses just one local variable of type @code{ Term}, the type used for -holding Yap terms, where the integer returned by the standard unix -function @code{getpid()} is stored as an integer term (the conversion is -done by @code{MkIntTerm(Int))}. Then it calls the pre-defined routine -@code{unify(Term*, Term*)} which in turn returns an integer denoting -success or failure of the unification. +through macros, defined in the include file, with names @var{YAP_ARG1}, +@var{YAP_ARG2}, ..., @var{YAP_ARG16} or with @var{YAP_A}(@var{N}) +where @var{N} is the argument number (starting with 1). In the present +case the function uses just one local variable of type @code{YAP_Term}, the +type used for holding Yap terms, where the integer returned by the +standard unix function @code{getpid()} is stored as an integer term (the +conversion is done by @code{YAP_MkIntTerm(Int))}. Then it calls the +pre-defined routine @code{YAP_Unify(YAP_Term, YAP_Term)} which in turn returns an +integer denoting success or failure of the unification. The role of the procedure @code{init_my_predicates} is to make known to -YAP, by calling @code{UserCPredicate}, the predicates being +YAP, by calling @code{YAP_UserCPredicate}, the predicates being defined in the file. This is in fact why, in the example above, @code{init_my_predicates} was passed as the third argument to @code{load_foreign_files}. @@ -12578,14 +12578,14 @@ The rest of this appendix describes exhaustively how to interface C to YAP. This section provides information about the primitives available to the C programmer for manipulating prolog terms. -Several C typedefs are included in the header file @code{yap/c_interface.h} to +Several C typedefs are included in the header file @code{yap/YapInterface.h} to describe, in a portable way, the C representation of prolog terms. The user should write is programs using this macros to ensure portability of code across different versions of YAP. -The more important typedef is @var{Term} which is used to denote the type of a -prolog term. +The more important typedef is @var{YAP_Term} which is used to denote the +type of a prolog term. Terms, from a point of view of the C-programmer, can be classified as follows @@ -12600,24 +12600,17 @@ follows @item compound terms @end table -Before trying to find out the kind of a term, the C-programmer should insure -it is not an instantiated variable using the interface primitive +@findex YAP_IsVarTerm (C-Interface function) +The primitive @example - Term Deref(Term) -@end example -@noindent -which follows a possibly empty chain of instantiations and returns a term which -is not an instantiated variable. - -Having done so, the primitive -@example - Bool IsVarTerm(Term) + YAP_Bool YAP_IsVarTerm(YAP_Term @var{t}) @end example @noindent +@findex YAP_IsNonVarTerm (C-Interface function) returns true iff its argument is an uninstantiated variable. Conversely the primitive @example - Bool IsGroundTerm(Term) + YAP_Bool YAP_NonVarTerm(YAP_Term @var{t}) @end example @noindent returns true iff its argument is not a variable. @@ -12625,133 +12618,184 @@ returns true iff its argument is not a variable. The user can create a new uninstantiated variable using the primitive @example - Term MkVarTerm() + Term YAP_MkVarTerm() @end example -The following primitives can be used to discriminate among the different kinds +@findex YAP_IsIntTerm (C-Interface function) +@findex YAP_IsFloatTerm (C-Interface function) +@findex YAP_IsDBRefTerm (C-Interface function) +@findex YAP_IsAtomTerm (C-Interface function) +@findex YAP_IsPairTerm (C-Interface function) +@findex YAP_IsApplTerm (C-Interface function) +The following primitives can be used to discriminate among the different types of non-variable terms: @example - Bool IsIntTerm(Term) - Bool IsFloatTerm(Term) - Bool IsDbRefTerm(Term) - Bool IsAtomTerm(Term) - Bool IsPairTerm(Term) - Bool IsApplTerm(Term) + YAP_Bool YAP_IsIntTerm(YAP_Term @var{t}) + YAP_Bool YAP_IsFloatTerm(YAP_Term @var{t}) + YAP_Bool YAP_IsDbRefTerm(YAP_Term @var{t}) + YAP_Bool YAP_IsAtomTerm(YAP_Term @var{t}) + YAP_Bool YAP_IsPairTerm(YAP_Term @var{t}) + YAP_Bool YAP_IsApplTerm(YAP_Term @var{t}) @end example -@noindent -@strong{Important Note:} when used on variables the primitives above -will return an unpredictable result. +Next, we mention the primitives that allow one to destruct and construct +terms. All the above primitives ensure that their result is +@i{dereferenced}, i.e. that it is not a pointer to another term. +@findex YAP_MkIntTerm (C-Interface function) +@findex YAP_IntOfTerm (C-Interface function) The following primitives are provided for creating an integer term from an integer and to access the value of an integer term. @example - Term MkIntTerm(Int) - Int IntOfTerm(Term) + YAP_Term YAP_MkIntTerm(YAP_Int @var{i}) + YAP_Int YAP_IntOfTerm(YAP_YAP_Term @var{t}) @end example @noindent -where @code{Int} is a typedef for the C integer type appropriate for the -machine or compiler in question (normally a 32 bit integer). Note that -the size of the allowed integers is implementation dependent but is always -greater or equal to 24 bits. - +where @code{YAP_Int} is a typedef for the C integer type appropriate for +the machine or compiler in question (normally a long integer). The size +of the allowed integers is implementation dependent but is always +greater or equal to 24 bits: usually 32 bits on 32 bit machines, and 64 +on 64 bit machines. +@findex YAP_MkFloatTerm (C-Interface function) +@findex YAP_FloatOfTerm (C-Interface function) The two following primitives play a similar role for floating-point terms @example - Term MkFloatTerm(flt) - flt FloatOfTerm(Term) + YAP_Term YAP_MkFloatTerm(YAP_flt @var{double}) + YAP_flt YAP_FloatOfTerm(YAP_YAP_Term @var{t}) @end example @noindent -where @code{flt} is a typedef for the appropriate C floating point type. +where @code{flt} is a typedef for the appropriate C floating point type, +nowadays a @code{double} - -No primitives are supplied to users for manipulating data base +Currently, no primitives are supplied to users for manipulating data base references. -A special typedef @code{Atom} is provided to describe prolog @i{atoms} and the -two following primitives can be used to manipulate atom terms +@findex YAP_MkAtomTerm (C-Interface function) +@findex YAP_AtomOfTerm (C-Interface function) +A special typedef @code{YAP_Atom} is provided to describe prolog +@i{atoms} (symbolic constants). The two following primitives can be used +to manipulate atom terms @example - Term MkAtomTerm(Atom) - Atom AtomOfTerm(Term) + YAP_Term YAP_MkAtomTerm(YAP_Atom at) + YAP_Atom YAP_AtomOfTerm(YAP_YAP_Term @var{t}) @end example @noindent -The two following primitives are available for associating atoms with their +@findex YAP_LookupAtom (C-Interface function) +@findex YAP_FullLookupAtom (C-Interface function) +@findex YAP_AtomName (C-Interface function) +The following primitives are available for associating atoms with their names @example - Atom LookupAtom(char *) - Atom FullLookupAtom(char *) - char* AtomName(Atom) + YAP_Atom YAP_LookupAtom(char * @var{s}) + YAP_Atom YAP_FullLookupAtom(char * @var{s}) + char *YAP_AtomName(YAP_Atom @var{t}) @end example -The function @code{LookupAtom} looks up an atom in the standard hash -table. The function @code{FullLookupAtom} will also search if the atom -had been "hidden". +The function @code{YAP_LookupAtom} looks up an atom in the standard hash +table. The function @code{YAP_FullLookupAtom} will also search if the +atom had been "hidden": this is useful for system maintenance from C +code. The functor @code{YAP_AtomName} returns a pointer to the string +for the atom. - -A @i{pair} is a Prolog term which consists of a pair of prolog terms designated -as the @i{head} and the @i{tail} of the term. The following primitives can -be used to manipulate pairs +@findex YAP_MkPairTerm (C-Interface function) +@findex YAP_MkNewPairTerm (C-Interface function) +@findex YAP_HeadOfTerm (C-Interface function) +@findex YAP_TailOfTerm (C-Interface function) +A @i{pair} is a Prolog term which consists of a tuple of two prolog +terms designated as the @i{head} and the @i{tail} of the term. Pairs are +most often used to build @emph{lists}. The following primitives can be +used to manipulate pairs: @example - Term MkPairTerm(Term Head, Term Tail) - Term HeadOfTerm(Term) - Term TailOfTerm(Term) + YAP_Term YAP_MkPairTerm(YAP_Term @var{Head}, YAP_Term @var{Tail}) + YAP_Term YAP_MkNewPairTerm(void) + YAP_Term YAP_HeadOfTerm(YAP_Term @var{t}) + YAP_Term YAP_TailOfTerm(YAP_Term @var{t}) @end example +One can construct a new pair from two terms, or one can just build a +pair whose head and tail are new unbound variables. Finally, one can +fetch the head or the tail. +@findex YAP_MkApplTerm (C-Interface function) +@findex YAP_MkNewApplTerm (C-Interface function) +@findex YAP_ArgOfTerm (C-Interface function) +@findex YAP_FunctorOfTerm (C-Interface function) A @i{compound} term consists of a @i{functor} and a sequence of terms with length equal to the @i{arity} of the functor. A functor, described in C by the typedef @code{Functor}, consists of an atom and of an integer. The following primitives were designed to manipulate compound terms and functors @example - Term MkApplTerm(Functor f, int n, Term[] args) - Functor FunctorOfTerm(Term) - Term ArgOfTerm(int argno,Term t) - Functor MkFunctor(Atom a,int arity) - Atom NameOfFunctor(Functor) - Int ArityOfFunctor(Functor) + YAP_Term YAP_MkApplTerm(YAP_Functor @var{f}, unsigned long int @var{n}, YAP_Term[] @var{args}) + YAP_Term YAP_MkNewApplTerm(YAP_Functor @var{f}, int @var{n}) + YAP_Term YAP_ArgOfTerm(int argno,YAP_Term @var{ts}) + YAP_Functor YAP_FunctorOfTerm(YAP_YAP_Term @var{ts}) @end example @noindent -where @code{args} should be an array of @code{n} terms with @code{n} equal to the -arity of the functor, and @code{argno} should be greater or equal to 1 and less -or equal to the arity of the functor. +The @code{YAP_MkApplTerm} function constructs a new term, with functor +@var{f} (of arity @var{n}), and using an array @var{args} of @var{n} +terms with @var{n} equal to the arity of the +functor. @code{YAP_MkNewApplTerm} builds up a compound term whose +arguments are unbound variables. @code{YAP_ArgOfTerm} gives an argument +to a compound term. @code{argno} should be greater or equal to 1 and +less or equal to the arity of the functor. -@strong{Note:} all the above primitives returning terms ensure that the -result is @i{dereferenced}, i.e. that it is not an instantiated variable. +YAP allows one to manipulate the functors of compound term. The function +@code{YAP_FunctorOfTerm} allows one to obtain a variable of type +@code{YAP_Functor} with the functor to a term. The following functions +then allow one to construct functors, and to obtain their name and arity. + +@findex YAP_MkFunctor (C-Interface function) +@findex YAP_NameOfFunctor (C-Interface function) +@findex YAP_ArityOfFunctor (C-Interface function) +@example + YAP_Functor YAP_MkFunctor(YAP_Atom @var{a},unsigned long int @var{arity}) + YAP_Atom YAP_NameOfFunctor(YAP_Functor @var{f}) + YAP_Int YAP_ArityOfFunctor(YAP_Functor @var{f}) +@end example +@noindent + +Note that the functor is essencially a pair formed by an atom, and +arity. @node Unifying Terms, Manipulating Strings, Manipulating Terms, C-Interface @section Unification -The following routine is provided for attempting the unification of two -prolog terms +@findex YAP_Unify (C-Interface function) +YAP provides a single routine to attempt the unification of two prolog +terms. The routine may succeed or fail: @example - Int unify(Term a, Term b) + Int YAP_Unify(YAP_Term @var{a}, YAP_Term @var{b}) @end example @noindent -which attempts to unify the terms pointed to by @code{a} and @code{b} returning -a non-zero value if the unification succeeds and zero otherwise. +The routine attempts to unify the terms @var{a} and +@var{b} returning @code{TRUE} if the unification succeeds and @code{FALSE} +otherwise. @node Manipulating Strings, Memory Allocation, Unifying Terms, C-Interface @section Strings +@findex YAP_StringToBuffer (C-Interface function) The YAP C-interface now includes an utility routine to copy a string represented as a list of a character codes to a previously allocated buffer @example - int StringToBuffer(Term String, char *buf, unsigned int bufsize) + int YAP_StringToBuffer(YAP_Term @var{String}, char *@var{buf}, unsigned int @var{bufsize}) @end example @noindent -The routine copies the list of character codes @code{String} to a -previously allocated buffer @code{buf}. The string including a -terminating null character must fit in @code{bufsize} characters, -otherwise the routine will simply fail. The @code{StringToBuffer} -routine fails and generates an exception if @code{String} is not a valid -string. +The routine copies the list of character codes @var{String} to a +previously allocated buffer @var{buf}. The string including a +terminating null character must fit in @var{bufsize} characters, +otherwise the routine will simply fail. The @var{StringToBuffer} routine +fails and generates an exception if @var{String} is not a valid string. +@findex YAP_BufferToString (C-Interface function) +@findex YAP_BufferToAtomList (C-Interface function) The C-interface also includes utility routines to do the reverse, that is, to copy a from a buffer to a list of character codes or to a list of character atomsr @example - Term BufferToString(char *buf) - Term BufferToAtomList(char *buf) + YAP_Term YAP_BufferToString(char *@var{buf}) + YAP_Term YAP_BufferToAtomList(char *@var{buf}) @end example @noindent The user-provided string must include a terminating null character. @@ -12759,17 +12803,20 @@ The user-provided string must include a terminating null character. @node Memory Allocation, Controlling Streams, Manipulating Strings, C-Interface @section Memory Allocation +@findex YAP_AllocSpaceFromYap (C-Interface function) The next routine can be used to ask space from the Prolog data-base: @example - void *AllocSpaceFromYap(int size) + void *YAP_AllocSpaceFromYap(int @var{size}) @end example @noindent The routine returns a pointer to a buffer allocated from the code area, -or @code{NULL} if no space was available. +or @code{NULL} if sufficient space was not available. -This Space can be released by using: +@findex YAP_FreeSpaceFromYap (C-Interface function) +The space allocated with @code{YAP_AllocSpaceFromYap} can be released +back to Yap by using: @example - void FreeSpaceFromYap(void *buf) + void YAP_FreeSpaceFromYap(void *@var{buf}) @end example @noindent The routine releases a buffer allocated from the code area. The system @@ -12779,11 +12826,12 @@ area. @node Controlling Streams, Calling Yap From C, Memory Allocation, C-Interface @section Controlling Yap Streams from @code{C} +@findex YAP_StreamToFileNo (C-Interface function) The C-Interface also provides the C-application with a measure of control over the Yap Input/Output system. The first routine allows one to find a file number given a current stream: @example - int YapStreamToFileNo(Term stream) + int YAP_StreamToFileNo(YAP_Term @var{stream}) @end example @noindent This function gives the file descriptor for a currently available @@ -12793,41 +12841,45 @@ negative. Moreover, Yap will not be aware of any direct operations on this stream, so information on, say, current stream position, may become stale. +@findex YAP_CloseAllOpenStreams (C-Interface function) A second routine that is sometimes useful is: @example - void YapCloseAllOpenStreams(void) + void YAP_CloseAllOpenStreams(void) @end example @noindent This routine closes the Yap Input/Output system except for the first three streams, that are always associated with the three standard Unix streams. It is most useful if you are doing @code{fork()}. +@findex YAP_OpenStream (C-Interface function) The next routine allows a currently open file to become a stream. The routine receives as arguments a file descriptor, the true file name as a string, an atom with the yser name, and a set of flags: @example - void YapOpenStream(void *FD, char *true, Term t, int flags) + void YAP_OpenStream(void *@var{FD}, char *@var{name}, YAP_Term @var{t}, int @var{flags}) @end example @noindent The available flags are @code{YAP_INPUT_STREAM}, @code{YAP_OUTPUT_STREAM}, @code{YAP_APPEND_STREAM}, @code{YAP_PIPE_STREAM}, @code{YAP_TTY_STREAM}, @code{YAP_POPEN_STREAM}, @code{YAP_BINARY_STREAM}, and @code{YAP_SEEKABLE_STREAM}. By default, the -stream is supposed to be at position 0. +stream is supposed to be at position 0. The argument @var{name} gives +the name by which YAP should know the new stream. @node Calling Yap From C, Writing C, Controlling Streams, C-Interface @section From @code{C} back to Prolog +@findex YAP_CallProlog (C-Interface function) Newer versions of YAP allow for calling the Prolog interpreter from @code{C}. One must first construct a goal @code{G}, and then it is sufficient to perform: @example - Int YapCallProlog(Term G) + YAP_Bool YapCallProlog(YAP_Term @var{G}) @end example @noindent -the result will be @code{0}, if the goal failed, or @code{1}, if the -goal succeeded. In this case, the variables in @var{G} will store the -values they have been unified with. Execution only proceeds until +the result will be @code{FALSE}, if the goal failed, or @code{TRUE}, if +the goal succeeded. In this case, the variables in @var{G} will store +the values they have been unified with. Execution only proceeds until finding the first solution to the goal, but you can call @code{findall/3} or friends if you need all the solutions. @@ -12837,22 +12889,28 @@ finding the first solution to the goal, but you can call We will distinguish two kinds of predicates: @table @i @item @i{deterministic} predicates which either fail or succeed but are not -backtrackable, like the one in the introduction; +backtrackable, like the one in the introduction; @item @i{backtrackable} predicates which can succeed more than once. @end table +@findex YAP_UserCPredicate (C-Interface function) The first kind of predicates should be implemented as a C function with no arguments which should return zero if the predicate fails and a non-zero value otherwise. The predicate should be declared to YAP, in the initialization routine, with a call to @example - void UserCPredicate(char *name, int *fn(), int arity); + void YAP_UserCPredicate(char *@var{name}, YAP_Bool *@var{fn}(), unsigned long int @var{arity}); @end example @noindent -where @code{name} is the name of the predicate, @code{fn} is the C function -implementing the predicate and @code{arity} is its arity. +where @var{name} is the name of the predicate, @var{fn} is the C function +implementing the predicate and @var{arity} is its arity. +@findex YAP_UserBackCPredicate (C-Interface function) +@findex YAP_PRESERVE_DATA (C-Interface function) +@findex YAP_PRESERVED_DATA (C-Interface function) +@findex YAP_cutsucceed (C-Interface function) +@findex YAP_cutfail (C-Interface function) For the second kind of predicates we need two C functions. The first one which is called when the predicate is first activated, and the second one to be called on backtracking to provide (possibly) other solutions. Note @@ -12883,7 +12941,7 @@ and a pointer variable to a structure of that type. @example typedef struct @{ - Term next_solution; /* the next solution */ + YAP_Term next_solution; /* the next solution */ @} n100_data_type; n100_data_type *n100_data; @@ -12894,25 +12952,27 @@ We now write the @code{C} function to handle the first call: @example static int start_n100() @{ - Term t = ARG1; - PRESERVE_DATA(n100_data,n100_data_type); - if(IsVarTerm(t)) @{ - n100_data->next_solution = MkIntTerm(0); + YAP_Term t = ARG1; + YAP_PRESERVE_DATA(n100_data,n100_data_type); + if(YAP_IsVarTerm(t)) @{ + n100_data->next_solution = YAP_MkIntTerm(0); return(continue_n100()); @} - if(!IsIntTerm(t) || IntOfTerm(t)<0 || IntOfTerm(t)>100) @{ - cut_fail(); + if(!YAP_IsIntTerm(t) || YAP_IntOfTerm(t)<0 || YAP_IntOfTerm(t)>100) @{ + YAP_cut_fail(); @} else @{ - cut_succeed(); + YAP_cut_succeed(); @} @} @end example The routine starts by getting the dereference value of the argument. -The call to @code{PRESERVE_DATA} is used to initialize the memory which will +The call to @code{YAP_PRESERVE_DATA} is used to initialize the memory which will hold the information to be preserved across backtracking. The first -argument is the variable we shall use, and the second its type. +argument is the variable we shall use, and the second its type. Note +that we can only use @code{YAP_PRESERVE_DATA} once, so often we will +want the variable to be a structure. If the argument of the predicate is a variable, the routine initializes the structure to be preserved across backtracking with the information @@ -12921,13 +12981,14 @@ continue_n100} to provide that solution. If the argument was not a variable, the routine then checks if it was an integer, and if so, if its value is positive and less than 100. In that case -it exits, denoting success, with @code{cut_succeed}, or otherwise exits with -@code{cut_fail} denoting failure. +it exits, denoting success, with @code{YAP_cut_succeed}, or otherwise exits with +@code{YAP_cut_fail} denoting failure. -The reason for using for using the macros @code{cut_succeed} and @code{cut_fail} -instead of just returning a non-zero value in the first case, and zero in the -second case, is that otherwise, if backtracking occurred later, the routine -@code{continue_n100} would be called to provide additional solutions. +The reason for using for using the functions @code{YAP_cut_succeed} and +@code{YAP_cut_fail} instead of just returning a non-zero value in the +first case, and zero in the second case, is that otherwise, if +backtracking occurred later, the routine @code{continue_n100} would be +called to provide additional solutions. The code required for the second function is @example @@ -12936,46 +12997,47 @@ static int continue_n100() int n; Term t; Term sol = ARG1; - PRESERVED_DATA(n100_data,n100_data_type); - n = IntOfTerm(n100_data->next_solution); + YAP_PRESERVED_DATA(n100_data,n100_data_type); + n = YAP_IntOfTerm(n100_data->next_solution); if( n == 100) @{ - t = MkIntTerm(n); - unify(&sol,&t); - cut_succeed(); + t = YAP_MkIntTerm(n); + YAP_Unify(&sol,&t); + YAP_cut_succeed(); @} else @{ - unify(&sol,&(n100_data->next_solution)); - n100_data->next_solution = MkIntTerm(n+1); - return(1); + YAP_Unify(&sol,&(n100_data->next_solution)); + n100_data->next_solution = YAP_MkIntTerm(n+1); + return(TRUE); @} @} @end example -Note that again the macro @code{PRESERVED_DATA} is used at the beginning of -the function to access the data preserved from the previous solution. -Then it checks if the last solution was found and in that case exits -with @code{cut_succeed} in order to cut any further backtracking. If this -is not the last solution then we save the value for the next solution in -the data structure and exit normally with 1 denoting success. Note also -that in any of the two cases we use the function @code{unify} to bind the -argument of the call to the value saved in @code{ -n100_state->next_solution}. +Note that again the macro @code{YAP_PRESERVED_DATA} is used at the +beginning of the function to access the data preserved from the previous +solution. Then it checks if the last solution was found and in that +case exits with @code{YAP_cut_succeed} in order to cut any further +backtracking. If this is not the last solution then we save the value +for the next solution in the data structure and exit normally with 1 +denoting success. Note also that in any of the two cases we use the +function @code{YAP_nify} to bind the argument of the call to the value +saved in @code{ n100_state->next_solution}. Note also that the only correct way to signal failure in a backtrackable -predicate is to use the @code{cut_fail} macro. +predicate is to use the @code{YAP_cut_fail} macro. Backtrackable predicates should be declared to YAP, in a way similar to what happened with deterministic ones, but using instead a call to @example - void UserBackCPredicate(char *name, - int *init(), int *cont(), int arity, int sizeof); + void YAP_UserBackCPredicate(char *@var{name}, + int *@var{init}(), int *@var{cont}(), + unsigned long int @var{arity}, unsigned int @var{sizeof}); @end example @noindent -where @code{name} is a string with the name of the predicate, @code{init} and -@code{cont} are the C functions used to start and continue the execution of -the predicate, @code{arity} is the predicate arity, and @code{sizeof} is +where @var{name} is a string with the name of the predicate, @var{init} and +@var{cont} are the C functions used to start and continue the execution of +the predicate, @var{arity} is the predicate arity, and @var{sizeof} is the size of the data to be preserved in the stack. @node Loading Objects, Sav&Rest, Writing C, C-Interface @@ -13022,13 +13084,18 @@ Yap4 includes several changes over the previous @code{load_foreign_files} interface. These changes were required to support the new binary code formats, such as ELF used in Solaris2 and Linux. @itemize @bullet +@item All Names of YAP objects now start with @var{YAP_}. This is +designed to avoid clashes with other code. Use @code{YapInterface.h} to +take advantage of the new interface. @code{c_interface.h} is still +available if you cannot port the code to the new interface. + @item Access to elements in the new interface always goes through @emph{functions}. This includes access to the argument registers, -@code{ARG1} to @code{ARG16}. This change breaks code such as -@code{unify(&ARG1,&t)}: +@code{YAP_ARG1} to @code{YAP_ARG16}. This change breaks code such as +@code{unify(&ARG1,&t)}, which is nowadays: @example @{ - unify(ARG1, t); + YAP_Unify(ARG1, t); @} @end example @@ -13065,7 +13132,7 @@ To actually use this library you must follow a five step process: @enumerate @item You must initialise the YAP environment. A single function, -@code{YapFastInit} asks for a contiguous chunk in your memory space, fills +@code{YAP_FastInit} asks for a contiguous chunk in your memory space, fills it in with the data-base, and sets up YAP's stacks and execution registers. You can use a saved space from a standard system by calling @code{save_program/1}. @@ -13074,7 +13141,7 @@ calling @code{save_program/1}. YAP. A query is a Prolog term, and you just have to use the same functions that are available in the C-interface. -@item You can then use @code{YapRunGoal(query)} to actually evaluate your +@item You can then use @code{YAP_RunGoal(query)} to actually evaluate your query. The argument is the query term @code{query}, and the result is 1 if the query succeeded, and 0 if it failed. @@ -13082,7 +13149,7 @@ if the query succeeded, and 0 if it failed. arguments were instantiated. @item If you want extra solutions, you can use -@code{YapRestartGoal()} to obtain the next solution. +@code{YAP_RestartGoal()} to obtain the next solution. @end enumerate @@ -13092,16 +13159,16 @@ program contains two facts for the procedure @t{b}: @example @cartouche #include -#include "Yap/c_interface.h" +#include "Yap/YapInterface.h" int main(int argc, char *argv[]) @{ - if (YapFastInit("saved_state") == YAP_BOOT_FROM_SAVED_ERROR) + if (YAP_FastInit("saved_state") == YAP_BOOT_FROM_SAVED_ERROR) exit(1); - if (YapRunGoal(MkAtomTerm(LookupAtom("do")))) @{ + if (YAP_RunGoal(YAP_MkAtomTerm(LookupAtom("do")))) @{ printf("Success\n"); - while (YapRestartGoal()) + while (YAP_RestartGoal()) printf("Success\n"); @} printf("NO\n"); diff --git a/include/c_interface.h b/include/c_interface.h index 6f8ff2f82..ff4d90b83 100644 --- a/include/c_interface.h +++ b/include/c_interface.h @@ -14,734 +14,294 @@ * * *************************************************************************/ -/******************* IMPORTANT ******************** - Due to a limitation of the DecStation loader any function (including - library functions) which is linked to yap can not be called directly - from C code loaded dynamically. - To go around this problem we adopted the solution of calling such - functions indirectly -****************************************************/ +#ifndef _c_interface_h -#include "yap_structs.h" +#define _c_interface_h 1 -#ifndef _Yap_c_interface_h -#define _Yap_c_interface_h 1 +#include "YapInterface.h" -/* - __BEGIN_DECLS should be used at the beginning of the C declarations, - so that C++ compilers don't mangle their names. __END_DECLS is used - at the end of C declarations. -*/ -#undef __BEGIN_DECLS -#undef __END_DECLS -#ifdef __cplusplus -# define __BEGIN_DECLS extern "C" { -# define __END_DECLS } -#else -# define __BEGIN_DECLS /* empty */ -# define __END_DECLS /* empty */ +#define CELL YAP_CELL + +#ifndef Bool +#define Bool YAP_Bool #endif -__BEGIN_DECLS +#define Int long int -#if defined(_MSC_VER) && defined(YAP_EXPORTS) -#define X_API __declspec(dllexport) -#else -#define X_API -#endif +#define flt double -/* Primitive Functions */ +#define Term YAP_Term -/* Term Deref(Term) */ -extern X_API Term PROTO(YapA,(int)); -#ifdef IndirectCalls -static Term (*YapIA)() = YapA; -#define A(I) (*YapIA)(I) -#else -#define A(I) YapA(I) -#endif -#define ARG1 A(1) -#define ARG2 A(2) -#define ARG3 A(3) -#define ARG4 A(4) -#define ARG5 A(5) -#define ARG6 A(6) -#define ARG7 A(7) -#define ARG8 A(8) -#define ARG9 A(9) -#define ARG10 A(10) -#define ARG11 A(11) -#define ARG12 A(12) -#define ARG13 A(13) -#define ARG14 A(14) -#define ARG15 A(15) -#define ARG16 A(16) +#define Functor YAP_Functor -/* Term Deref(Term) */ -extern X_API Term PROTO(Deref,(Term)); -#ifdef IndirectCalls -static Term (*YapIDeref)() = Deref; -#define Deref(T) (*YapIDeref)(T) -#endif +#define Atom YAP_Atom -/* Bool IsVarTerm(Term) */ -extern X_API Bool PROTO(YapIsVarTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsVarTerm)() = YapIsVarTerm; -#define IsVarTerm(T) (*YapIIsVarTerm)(T) -#else -#define IsVarTerm(T) YapIsVarTerm(T) -#endif +#define yap_init_args YAP_init_args -/* Bool IsNonVarTerm(Term) */ -extern X_API Bool PROTO(YapIsNonVarTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsNonVarTerm)() = YapIsNonVarTerm; -#define IsNonVarTerm(T) (*YapIIsNonVarTerm)(T) -#else -#define IsNonVarTerm(T) YapIsNonVarTerm(T) -#endif +#define A(X) YAP_A(X) +#define ARG1 YAP_ARG1 +#define ARG2 YAP_ARG2 +#define ARG3 YAP_ARG3 +#define ARG4 YAP_ARG4 +#define ARG5 YAP_ARG5 +#define ARG6 YAP_ARG6 +#define ARG7 YAP_ARG7 +#define ARG8 YAP_ARG8 +#define ARG9 YAP_ARG9 +#define ARG10 YAP_ARG10 +#define ARG11 YAP_ARG11 +#define ARG12 YAP_ARG12 +#define ARG13 YAP_ARG13 +#define ARG14 YAP_ARG14 +#define ARG15 YAP_ARG15 +#define ARG16 YAP_ARG16 -/* Term MkVarTerm() */ -extern X_API Term PROTO(YapMkVarTerm,(void)); -#ifdef IndirectCalls -static Term (*YapIMkVarTerm)() = YapMkVarTerm; -#define MkVarTerm() (*YapIMkVarTerm)() -#else -#define MkVarTerm() YapMkVarTerm() -#endif +/* YAP_Term Deref(YAP_Term) */ +#define Deref(t) YAP_Deref(t) +#define YapDeref(t) YAP_Deref(t) -/* Bool IsIntTerm(Term) */ -extern X_API Bool PROTO(YapIsIntTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsIntTerm)() = YapIsIntTerm; -#define IsIntTerm(T) (*YapIIsIntTerm)(T) -#else -#define IsIntTerm(T) YapIsIntTerm(T) -#endif +/* YAP_Bool IsVarTerm(YAP_Term) */ +#define IsVarTerm(t) YAP_IsVarTerm(t) +#define YapIsVarTerm(t) YAP_IsVarTerm(t) -/* Bool IsFloatTerm(Term) */ -extern X_API Bool PROTO(YapIsFloatTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsFloatTerm)() = YapIsFloatTerm; -#define IsFloatTerm(T) (*YapIIsFloatTerm)(T) -#else -#define IsFloatTerm(T) YapIsFloatTerm(T) -#endif +/* YAP_Bool IsNonVarTerm(YAP_Term) */ +#define IsNonVarTerm(t) YAP_IsNonVarTerm(t) +#define YapIsNonVarTerm(t) YAP_IsNonVarTerm(t) -/* Bool IsDbRefTerm(Term) */ -extern X_API Bool PROTO(YapIsDbRefTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsDbRefTerm)() = YapIsDbRefTerm; -#define IsDbRefTerm(T) (*YapIIsDbRefTerm)(T) -#else -#define IsDbRefTerm(T) YapIsDbRefTerm(T) -#endif +/* YAP_Term MkVarTerm() */ +#define MkVarTerm() YAP_MkVarTerm() +#define YapMkVarTerm() YAP_MkVarTerm() -/* Bool IsAtomTerm(Term) */ -extern X_API Bool PROTO(YapIsAtomTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsAtomTerm)() = YapIsAtomTerm; -#define IsAtomTerm(T) (*YapIIsAtomTerm)(T) -#else -#define IsAtomTerm(T) YapIsAtomTerm(T) -#endif +/* YAP_Bool IsIntTerm(YAP_Term) */ +#define IsIntTerm(t) YAP_IsIntTerm(t) +#define YapIsIntTerm(t) YAP_IsIntTerm(t) -/* Bool IsPairTerm(Term) */ -extern X_API Bool PROTO(YapIsPairTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsPairTerm)() = YapIsPairTerm; -#define IsPairTerm(T) (*YapIIsPairTerm)(T) -#else -#define IsPairTerm(T) YapIsPairTerm(T) -#endif +/* YAP_Bool IsFloatTerm(YAP_Term) */ +#define IsFloatTerm(t) YAP_IsFloatTerm(t) +#define YapIsFloatTerm(t) YAP_IsFloatTerm(t) -/* Bool IsApplTerm(Term) */ -extern X_API Bool PROTO(YapIsApplTerm,(Term)); -#ifdef IndirectCalls -static Bool (*YapIIsApplTerm)() = YapIsApplTerm; -#define IsApplTerm(T) (*YapIIsApplTerm)(T) -#else -#define IsApplTerm(T) YapIsApplTerm(T) -#endif +/* YAP_Bool IsDbRefTerm(YAP_Term) */ +#define IsDbRefTerm(t) YAP_IsDbRefTerm(t) +#define YapIsDbRefTerm(t) YAP_IsDbRefTerm(t) -/* Term MkIntTerm(Int) */ -extern X_API Term PROTO(YapMkIntTerm,(Int)); -#ifdef IndirectCalls -static Term (*YapIMkIntTerm)() = YapMkIntTerm; -#define MkIntTerm(T) (*YapIMkIntTerm)(T) -#else -#define MkIntTerm(T) YapMkIntTerm(T) -#endif +/* YAP_Bool IsAtomTerm(YAP_Term) */ +#define IsAtomTerm(t) YAP_IsAtomTerm(t) +#define YapIsAtomTerm(t) YAP_IsAtomTerm(t) -/* Int IntOfTerm(Term) */ -extern X_API Int PROTO(YapIntOfTerm,(Term)); -#ifdef IndirectCalls -static Int (*YapIIntOfTerm)() = YapIntOfTerm; -#define IntOfTerm(T) (*YapIIntOfTerm)(T) -#else -#define IntOfTerm(T) YapIntOfTerm(T) -#endif +/* YAP_Bool IsPairTerm(YAP_Term) */ +#define IsPairTerm(t) YAP_IsPairTerm(t) +#define YapIsPairTerm(t) YAP_IsPairTerm(t) -/* Term MkFloatTerm(flt) */ -extern X_API Term PROTO(YapMkFloatTerm,(flt)); -#ifdef IndirectCalls -static Term (*YapIMkFloatTerm)() = YapMkFloatTerm; -#define MkFloatTerm(T) (*YapIMkFloatTerm)(T) -#else -#define MkFloatTerm(T) YapMkFloatTerm(T) -#endif +/* YAP_Bool IsApplTerm(YAP_Term) */ +#define IsApplTerm(t) YAP_IsApplTerm(t) +#define YapIsApplTerm(t) YAP_IsApplTerm(t) -/* flt FloatOfTerm(Term) */ -extern X_API flt PROTO(YapFloatOfTerm,(Term)); -#ifdef IndirectCalls -static flt (*YapIFloatOfTerm)() = YapFloatOfTerm; -#define FloatOfTerm(T) (*YapIFloatOfTerm)(T) -#else -#define FloatOfTerm(T) YapFloatOfTerm(T) -#endif +/* Term MkIntTerm(YAP_Int) */ +#define MkIntTerm(t) YAP_MkIntTerm(t) +#define YapMkIntTerm(t) YAP_MkIntTerm(t) + +/* YAP_Int IntOfTerm(Term) */ +#define IntOfTerm(t) YAP_IntOfTerm(t) +#define YapIntOfTerm(t) YAP_IntOfTerm(t) + +/* Term MkFloatTerm(YAP_flt) */ +#define MkFloatTerm(f) YAP_MkFloatTerm(f) +#define YapMkFloatTerm(f) YAP_MkFloatTerm(f) + +/* YAP_flt FloatOfTerm(YAP_Term) */ +#define FloatOfTerm(t) YAP_FloatOfTerm(t) +#define YapFloatOfTerm(t) YAP_FloatOfTerm(t) /* Term MkAtomTerm(Atom) */ -extern X_API Term PROTO(YapMkAtomTerm,(Atom)); -#ifdef IndirectCalls -static Term (*YapIMkAtomTerm)() = YapMkAtomTerm; -#define MkAtomTerm(T) (*YapIMkAtomTerm)(T) -#else -#define MkAtomTerm(T) YapMkAtomTerm(T) -#endif +#define MkAtomTerm(a) YAP_MkAtomTerm(a) +#define YapMkAtomTerm(a) YAP_MkAtomTerm(a) -/* Atom AtomOfTerm(Term) */ -extern X_API Atom PROTO(YapAtomOfTerm,(Term)); -#ifdef IndirectCalls -static Atom (*YapIAtomOfTerm)() = YapAtomOfTerm; -#define AtomOfTerm(T) (*YapIAtomOfTerm)(T) -#else -#define AtomOfTerm(T) YapAtomOfTerm(T) -#endif +/* YAP_Atom AtomOfTerm(Term) */ +#define AtomOfTerm(t) YAP_AtomOfTerm(t) +#define YapAtomOfTerm(t) YAP_AtomOfTerm(t) -/* Atom LookupAtom(char *) */ -extern X_API Atom PROTO(YapLookupAtom,(char *)); -#ifdef IndirectCalls -static Atom (*YapILookupAtom)() = YapLookupAtom; -#define LookupAtom(T) (*YapILookupAtom)(T) -#else -#define LookupAtom(T) YapLookupAtom(T) -#endif +/* YAP_Atom LookupAtom(char *) */ +#define LookupAtom(s) YAP_LookupAtom(s) +#define YapLookupAtom(s) YAP_LookupAtom(s) -/* Atom FullLookupAtom(char *) */ -extern X_API Atom PROTO(YapFullLookupAtom,(char *)); -#ifdef IndirectCalls -static Atom (*YapIFullLookupAtom)() = YapFullLookupAtom; -#define FullLookupAtom(T) (*YapIFullLookupAtom)(T) -#else -#define FullLookupAtom(T) YapFullLookupAtom(T) -#endif +/* YAP_Atom FullLookupAtom(char *) */ +#define FullLookupAtom(s) YAP_FullLookupAtom(s) +#define YapFullLookupAtom(s) YAP_FullLookupAtom(s) -/* char* AtomName(Atom) */ -extern X_API char *PROTO(YapAtomName,(Atom)); -#ifdef IndirectCalls -static char *((*YapIAtomName)()) = YapAtomName; -#define AtomName(T) (*YapIAtomName)(T) -#else -#define AtomName(T) YapAtomName(T) -#endif +/* char* AtomName(YAP_Atom) */ +#define AtomName(a) YAP_AtomName(a) +#define YapAtomName(a) YAP_AtomName(a) -/* Term MkPairTerm(Term Head, Term Tail) */ -extern X_API Term PROTO(YapMkPairTerm,(Term,Term)); -#ifdef IndirectCalls -static Term (*YapIMkPairTerm)() = YapMkPairTerm; -#define MkPairTerm(T1,T2) (*YapIMkPairTerm)(T1,T2) -#else -#define MkPairTerm(T1,T2) YapMkPairTerm(T1,T2) -#endif +/* YAP_Term MkPairTerm(YAP_Term Head, YAP_Term Tail) */ +#define MkPairTerm(h,t) YAP_MkPairTerm(h,t) +#define YapMkPairTerm(h,t) YAP_MkPairTerm(h,t) -/* Term MkNewPairTerm(void) */ -extern X_API Term PROTO(YapMkNewPairTerm,(void)); -#ifdef IndirectCalls -static Term (*YapIMkNewPairTerm)() = YapMkNewPairTerm; -#define MkNewPairTerm() (*YapIMkNewPairTerm)() -#else -#define MkNewPairTerm() YapMkNewPairTerm() -#endif +/* YAP_Term MkNewPairTerm(void) */ +#define MkNewPairTerm() YAP_MkNewPairTerm() +#define YapMkNewPairTerm() YAP_MkNewPairTerm() /* Term HeadOfTerm(Term) */ -extern X_API Term PROTO(YapHeadOfTerm,(Term)); -#ifdef IndirectCalls -static Term (*YapIHeadOfTerm)() = YapHeadOfTerm; -#define HeadOfTerm(T) (*YapIHeadOfTerm)(T) -#else -#define HeadOfTerm(T) YapHeadOfTerm(T) -#endif +#define HeadOfTerm(t) YAP_HeadOfTerm(t) +#define YapHeadOfTerm(t) YAP_HeadOfTerm(t) /* Term TailOfTerm(Term) */ -extern X_API Term PROTO(YapTailOfTerm,(Term)); -#ifdef IndirectCalls -static Term (*YapITailOfTerm)() = YapTailOfTerm; -#define TailOfTerm(T) (*YapITailOfTerm)(T) -#else -#define TailOfTerm(T) YapTailOfTerm(T) -#endif +#define TailOfTerm(t) YAP_TailOfTerm(t) +#define YapTailOfTerm(t) YAP_TailOfTerm(t) +/* YAP_Term MkApplTerm(YAP_Functor f, int n, YAP_Term[] args) */ +#define MkApplTerm(f,i,ts) YAP_MkApplTerm(f,i,ts) +#define YapMkApplTerm(f,i,ts) YAP_MkApplTerm(f,i,ts) -/* Term MkApplTerm(Functor f, int n, Term[] args) */ -extern X_API Term PROTO(YapMkApplTerm,(Functor,int,Term *)); -#ifdef IndirectCalls -static Term (*YapIMkApplTerm)() = YapMkApplTerm; -#define MkApplTerm(F,N,As) (*YapIMkApplTerm)(F,N,As) -#else -#define MkApplTerm(F,N,As) YapMkApplTerm(F,N,As) -#endif +/* YAP_Term MkNewApplTerm(YAP_Functor f, int n) */ +#define MkNewApplTerm(f,i) YAP_MkNewApplTerm(f,i) +#define YapMkNewApplTerm(f,i) YAP_MkNewApplTerm(f,i) -/* Term MkNewApplTerm(Functor f, int n) */ -extern X_API Term PROTO(YapMkNewApplTerm,(Functor,int)); -#ifdef IndirectCalls -static Term (*YapIMkNewApplTerm)() = YapMkNewApplTerm; -#define MkNewApplTerm(F,N) (*YapIMkNewApplTerm)(F,N) -#else -#define MkNewApplTerm(F,N) YapMkNewApplTerm(F,N) -#endif +/* YAP_Functor YAP_FunctorOfTerm(Term) */ +#define FunctorOfTerm(t) YAP_FunctorOfTerm(t) +#define YapFunctorOfTerm(t) YAP_FunctorOfTerm(t) +/* YAP_Term ArgOfTerm(int argno,YAP_Term t) */ +#define ArgOfTerm(i,t) YAP_ArgOfTerm(i,t) +#define YapArgOfTerm(i,t) YAP_ArgOfTerm(i,t) -/* Functor FunctorOfTerm(Term) */ -extern X_API Functor PROTO(YapFunctorOfTerm,(Term)); -#ifdef IndirectCalls -static Functor (*YapIFunctorOfTerm)() = YapFunctorOfTerm; -#define FunctorOfTerm(T) (*YapIFunctorOfTerm)(T) -#else -#define FunctorOfTerm(T) YapFunctorOfTerm(T) -#endif +/* YAP_Functor MkFunctor(YAP_Atom a,int arity) */ +#define MkFunctor(a,i) YAP_MkFunctor(a,i) +#define YapMkFunctor(a,i) YAP_MkFunctor(a,i) -/* Term ArgOfTerm(int argno,Term t) */ -extern X_API Term PROTO(YapArgOfTerm,(int,Term)); -#ifdef IndirectCalls -static Term (*YapIArgOfTerm)() = YapArgOfTerm; -#define ArgOfTerm(N,T) (*YapIArgOfTerm)(N,T) -#else -#define ArgOfTerm(N,T) YapArgOfTerm(N,T) -#endif +/* YAP_Atom NameOfFunctor(Functor) */ +#define NameOfFunctor(f) YAP_NameOfFunctor(f) +#define YapNameOfFunctor(f) YAP_NameOfFunctor(f) -/* Functor MkFunctor(Atom a,int arity) */ -extern X_API Functor PROTO(YapMkFunctor,(Atom,int)); -#ifdef IndirectCalls -static Functor (*YapIMkFunctor)() = YapMkFunctor; -#define MkFunctor(A,N) (*YapIMkFunctor)(A,N) -#else -#define MkFunctor(A,N) YapMkFunctor(A,N) -#endif +/* YAP_Int YAP_ArityOfFunctor(Functor) */ +#define ArityOfFunctor(f) YAP_ArityOfFunctor(f) +#define YapArityOfFunctor(f) YAP_ArityOfFunctor(f) -/* Atom NameOfFunctor(Functor) */ -extern X_API Atom PROTO(YapNameOfFunctor,(Functor)); -#ifdef IndirectCalls -static Atom (*YapINameOfFunctor)() = YapNameOfFunctor; -#define NameOfFunctor(T) (*YapINameOfFunctor)(T) -#else -#define NameOfFunctor(T) YapNameOfFunctor(T) -#endif +#define PRESERVE_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace()) +#define PRESERVED_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace()) -/* Int ArityOfFunctor(Functor) */ -extern X_API Int PROTO(YapArityOfFunctor,(Functor)); -#ifdef IndirectCalls -static Int (*YapIArityOfFunctor)() = YapArityOfFunctor; -#define ArityOfFunctor(T) (*YapIArityOfFunctor)(T) -#else -#define ArityOfFunctor(T) YapArityOfFunctor(T) -#endif - -/* void ExtraSpace(void) */ -extern X_API void *PROTO(YapExtraSpace,(void)); -#ifdef IndirectCalls -static void *(*YapIExtraSpace)() = YapExtraSpace; -#define YapExtraSpace() (*YapExtraSpace)() -#endif - -#define PRESERVE_DATA(ptr, type) (ptr = (type *)YapExtraSpace()) -#define PRESERVED_DATA(ptr, type) (ptr = (type *)YapExtraSpace()) - -/* Int unify(Term a, Term b) */ -extern X_API Int PROTO(YapUnify,(Term, Term)); -#ifdef IndirectCalls -static Int (*YapIUnify)() = YapUnify; -#define unify(T1,T2) (*YapIUnify)(T1,T2) -#else -#define unify(T1,T2) YapUnify(T1,T2) -#endif +/* YAP_Int unify(YAP_Term a, YAP_Term b) */ +#define unify() YAP_Unify(t, t) +#define YapUnify() YAP_Unify(t, t) /* void UserCPredicate(char *name, int *fn(), int arity) */ -extern X_API void PROTO(UserCPredicate,(char *, int (*)(void), int)); -#ifdef IndirectCalls -static void (*YapIUserCPredicate)() = UserCPredicate; -#define UserCPredicate(N,F,A) (*YapIUserCPredicate)(N,F,A) -#endif +#define UserCPredicate(s,f,i) YAP_UserCPredicate(s,f,i); /* void UserBackCPredicate(char *name, int *init(), int *cont(), int arity, int extra) */ -extern X_API void PROTO(UserBackCPredicate,(char *, int (*)(void), int (*)(void), int, int)); -#ifdef IndirectCalls -static void (*YapIUserBackCPredicate)() = UserBackCPredicate; -#define UserBackCPredicate(N,F,G,A,B) (*YapIUserBackCPredicate)(N,F,G,A,B) -#endif +#define UserBackCPredicate(s,f1,f2,i,i2) YAP_UserBackCPredicate(s,f,i,i2) /* void UserCPredicate(char *name, int *fn(), int arity) */ -extern X_API void PROTO(YapUserCPredicateWithArgs,(char *, int (*)(void), Int,Int)); -#ifdef IndirectCalls -static void (*YapIUserCPredicateWithArgs)() = UserCPredicateWithArgs; -#define YapUserCPredicateWithArgs(N,F,A,M) (*YapIUserCPredicateWithArgs)(N,F,A,M) -#endif - -/* void CallProlog(Term t) */ -extern X_API Int PROTO(YapCallProlog,(Term t)); -#ifdef IndirectCalls -static Int (*YapICallProlog)() = YapCallProlog; -#define CallProlog(t) (*YapICallProlog)(t) -#else -#define CallProlog(t) YapCallProlog(t) -#endif +#define UserCPredicateWithArgs(s,f,i1,i2) YAP_UserCPredicateWithArgs(s,f,i1,i2) +/* void CallProlog(YAP_Term t) */ +#define CallProlog(t) YAP_CallProlog(t) +#define YapCallProlog(t) YAP_CallProlog(t) /* void cut_fail(void) */ -extern X_API Int PROTO(Yapcut_fail,(void)); -#ifdef IndirectCalls -static Int (*YapIcut_fail)() = Yapcut_fail; -#define cut_fail() (*YapIcut_fail)() -#else -#define cut_fail() Yapcut_fail() -#endif +#define cut_fail() YAP_cutfail() /* void cut_succeed(void) */ -extern X_API Int PROTO(Yapcut_succeed,(void)); -#ifdef IndirectCalls -static Int (*YapIcut_succeed)() = Yapcut_succeed; -#define cut_succeed() (*YapIcut_succeed)() -#else -#define cut_succeed() Yapcut_succeed() -#endif +#define cut_succeed() YAP_cutsucceed() /* void *AllocSpaceFromYap(int) */ -extern X_API void *PROTO(YapAllocSpaceFromYap,(unsigned int)); -#ifdef IndirectCalls -static void (*YapIAllocSpaceFromYap)() = YapAllocSpaceFromYap; -#define AllocSpaceFromYap(SIZE) (*YapIAllocSpaceFromYap)(SIZE) -#else -#define AllocSpaceFromYap(SIZE) YapAllocSpaceFromYap(SIZE) -#endif +#define AllocSpaceFromYap(s) YAP_AllocSpaceFromYap(s) /* void FreeSpaceFromYap(void *) */ -extern X_API void PROTO(YapFreeSpaceFromYap,(void *)); -#ifdef IndirectCalls -static void (YapIFreeSpaceFromYap)() = YapFreeSpaceFromYap; -#define FreeSpaceFromYap(PTR) (*YapIFreeSpaceFromYap)(PTR) -#else -#define FreeSpaceFromYap(PTR) YapFreeSpaceFromYap(PTR) -#endif +#define FreeSpaceFromYap(s) YAP_FreeSpaceFromYap(s) -/* int YapRunGoal(Term) */ -extern X_API int PROTO(YapRunGoal,(Term)); -#ifdef IndirectCalls -static int (YapIRunGoal)() = YapRunGoal; -#define YapRunGoal(T) (*YapIRunGoal)(T) -#endif +/* int YAP_RunGoal(YAP_Term) */ +#define RunGoal(t) YAP_RunGoal(t) +#define YapRunGoal(t) YAP_RunGoal(t) -/* int YapRestartGoal(void) */ -extern X_API int PROTO(YapRestartGoal,(void)); -#ifdef IndirectCalls -static int (YapIRestartGoal)() = YapRestartGoal; -#define YapRestartGoal() (*YapIRestartGoal)() -#endif +/* int YAP_RestartGoal(void) */ +#define RestartGoal() YAP_RestartGoal() +#define YapRestartGoal() YAP_RestartGoal() -/* int YapContinueGoal(void) */ -extern X_API int PROTO(YapContinueGoal,(void)); -#ifdef IndirectCalls -static int (YapIContinueGoal)() = YapContinueGoal; -#define YapContinueGoal() (*YapIContinueGoal)() -#endif +/* int YAP_ContinueGoal(void) */ +#define ContinueGoal() YAP_ContinueGoal() +#define YapContinueGoal() YAP_ContinueGoal() -/* void YapPruneGoal(void) */ -extern X_API void PROTO(YapPruneGoal,(void)); -#ifdef IndirectCalls -static void (YapIPruneGoal)() = YapPruneGoal; -#define YapPruneGoal() (*YapIPruneGoal)() -#endif +/* void YAP_PruneGoal(void) */ +#define PruneGoal() YAP_PruneGoal() +#define YapPruneGoal() YAP_PruneGoal() -/* int YapGoalHasException(void) */ -extern X_API int PROTO(YapGoalHasException,(Term *)); -#ifdef IndirectCalls -static int (YapIGoalHasException)(TP) = YapGoalHasException; -#define YapGoalHasException(TP) (*YapIGoalHasException)(TP) -#endif +/* int YAP_GoalHasException(void) */ +#define GoalHasException(tp) YAP_GoalHasException(tp) +#define YapGoalHasException(tp) YAP_GoalHasException(tp) -/* int YapReset(void) */ -extern X_API void PROTO(YapReset,(void)); -#ifdef IndirectCalls -static void (YapIReset)() = YapReset; -#define YapReset() (*YapIReset)() -#endif +/* int YAP_Reset(void) */ +#define YapReset() YAP_Reset() -/* void YapError(char *) */ -extern X_API void PROTO(YapError,(char *)); -#ifdef IndirectCalls -static void (YapIError)() = YapError; -#define YapError(T) (*YapIError)(T) -#endif +/* void YAP_Error(char *) */ +#define YapError(s) YAP_Error(s) -/* Term YapRead(int (*)(void)) */ -extern X_API Term PROTO(YapRead,(int (*)(void))); -#ifdef IndirectCalls -static Term (YapIRead)() = YapRead; -#define YapRead(F) (*YapIRead)(F) -#endif +/* YAP_Term YAP_Read(int (*)(void)) */ +#define YapRead(f) YAP_Read(f); -/* void YapWrite(Term,void (*)(int),int) */ -extern X_API void PROTO(YapWrite,(Term,void (*)(int),int)); -#ifdef IndirectCalls -static void (YapIWrite)() = YapWrite; -#define YapWrite(T,W,F) (*YapIWrite)(T,W,F) -#endif +/* void YAP_Write(YAP_Term,void (*)(int),int) */ +#define YapWrite(t,f) YAP_Write(t,f); -/* char *YapCompileClause(Term) */ -extern X_API char *PROTO(YapCompileClause,(Term)); -#ifdef IndirectCalls -static char *(YapICompileClause)() = YapCompileClause; -#define YapCompileClause(C) (*YapICompileClause)(C) -#endif +/* char *YAP_CompileClause(YAP_Term) */ +#define CompileClause(t) YAP_CompileClause(t) +#define YapCompileClause(t) YAP_CompileClause(t) -/* int YapInit(yap_init_args *) */ -extern X_API int PROTO(YapInit,(yap_init_args *)); -#ifdef IndirectCalls -static int (YapIInit)() = YapInit; -#define YapInit(T) (*YapIInit)(T) -#endif +/* int YAP_Init(YAP_init_args *) */ +#define YapInit(as) YAP_Init(as) -/* int YapFastInit(char *) */ -extern X_API int PROTO(YapFastInit,(char *)); -#ifdef IndirectCalls -static int (YapIFastInit)() = YapFastInit; -#define YapFastInit(S) (*YapIFastInit)(S) -#endif +/* int YAP_FastInit(char *) */ +#define YapFastInit(s) YAP_FastInit(s) -/* int YapInitConsult(int, char *) */ -extern X_API int PROTO(YapInitConsult,(int, char *)); -#ifdef IndirectCalls -static int (YapIInitConsult)() = YapInitConsult; -#define YapInitConsult(M,F) (*YapIInitConsult)(M,F) -#endif +/* int YAP_InitConsult(int, char *) */ +#define YapInitConsult(i,s) YAP_InitConsult(i,s) -/* int YapStartConsult(int, char *) */ -extern X_API int PROTO(YapEndConsult,(void)); -#ifdef IndirectCalls -static int (YapIEndConsult)() = YapEndConsult; -#define YapEndConsult(M,F) (*YapIEndConsult)(M,F) -#endif +/* int YAP_StartConsult(int, char *) */ +#define YapEndConsult() YAP_EndConsult() -/* void YapExit(int) */ -extern X_API void PROTO(YapExit,(int)); -#ifdef IndirectCalls -static int (YapIExit)() = YapExit; -#define YapExit(I) (*YapIExit)(I) -#endif +/* void YAP_Exit(int) */ +#define YapExit(code) YAP_Exit(code) -/* void YapPutValue(Atom, Term) */ -extern X_API void PROTO(YapPutValue,(Atom, Term)); -#ifdef IndirectCalls -static Term (YapIPutValue)() = YapPutValue; -#define YapPutValue(A,T) (*YapIPutValue)(A,T) -#endif +/* void YAP_PutValue(YAP_Atom, YAP_Term) */ +#define PutValue() YAP_PutValue(a, t) +#define YapPutValue() YAP_PutValue(a, t) -/* Term YapGetValue(Atom) */ -extern X_API Term PROTO(YapGetValue,(Atom)); -#ifdef IndirectCalls -static Term (YapIGetValue)() = YapGetValue; -#define YapGetValue(A) (*YapIGetValue)(A) -#endif +/* YAP_Term YAP_GetValue(YAP_Atom) */ +#define GetValue(a) YAP_GetValue(a) +#define YapGetValue(a) YAP_GetValue(a) -/* int StringToBuffer(Term,char *,unsigned int) */ -extern X_API int PROTO(YapStringToBuffer,(Term,char *,unsigned int)); -#ifdef IndirectCalls -static void (YapIStringToBuffer)() = YapStringToBuffer; -#define StringToBuffer(T,BUF,SIZE) (*YapIStringToBuffer)(T,BUF,SIZE) -#else -#define StringToBuffer(T,BUF,SIZE) YapStringToBuffer(T,BUF,SIZE) -#endif +/* int StringToBuffer(YAP_Term,char *,unsigned int) */ +#define StringToBuffer(t,s,l) YAP_StringToBuffer(t,s,l) +#define YapStringToBuffer(t,s,l) YAP_StringToBuffer(t,s,l) /* int BufferToString(char *) */ -extern X_API Term PROTO(YapBufferToString,(char *)); -#ifdef IndirectCalls -static void (YapIBufferToString)() = YapBufferToString; -#define BufferToString(BUF) (*YapIBufferToString)(BUF) -#else -#define BufferToString(BUF) YapBufferToString(BUF) -#endif +#define BufferToString(s) YAP_BufferToString(s) +#define YapBufferToString(s) YAP_BufferToString(s) /* int BufferToAtomList(char *) */ -extern X_API Term PROTO(YapBufferToAtomList,(char *)); -#ifdef IndirectCalls -static void (YapIBufferToAtomList)() = YapBufferToAtomList; -#define BufferToAtomList(BUF) (*YapIBufferToAtomList)(BUF) -#else -#define BufferToAtomList(BUF) YapBufferToAtomList(BUF) -#endif +#define BufferToAtomList(s) YAP_BufferToAtomList(s) +#define YapBufferToAtomList(s) YAP_BufferToAtomList(s) -/* void YapInitSocks(char *,long) */ -extern X_API int PROTO(YapInitSocks,(char *,long)); -#ifdef IndirectCalls -static int (YapIInitSocks)(char *,long) = YapInitSocks; -#define YapInitSocks(S,I) (*YapIInitSocks)(S,I) -#endif +/* void YAP_InitSocks(char *,long) */ +#define InitSocks(s,l) YAP_InitSocks(s,l) +#define YapInitSocks(s,l) YAP_InitSocks(s,l) #ifdef SFUNC #define SFArity 0 -extern X_API Term *ArgsOfSFTerm(); -#ifdef IndirectCalls -static Term *((*YapIArgsOfSFTerm)()) = ArgsOfSFTerm; -#define ArgsOfSFTerm(T) (*YapIArgsOfSFTerm)(T) -#endif -extern X_API Term MkSFTerm(); -#ifdef IndirectCalls -static Term (*YapIMkSFTerm)() = MkSFTerm; -#define MkSFTerm(F,N,A,EV) (*YapIMkSFTerm)(F,N,A,EV) -#endif +#define ArgsOfSFTerm(s,t) YAP_ArgsOfSFTerm(s,t) + +extern MkSFTerm(t) YAP_MkSFTerm(t) #endif /* SFUNC */ -/* Term YapSetOutputMessage() */ -extern X_API void PROTO(YapSetOutputMessage,(void)); -#ifdef IndirectCalls -static void (*YapISetOutputMessage)() = YapSetOutputMessage; -#define YapSetOutputMessage() (*YapISetOutputMessage)() -#endif +/* YAP_Term YAP_SetOutputMessage() */ +#define YapSetOutputMessage(s) YAP_SetOutputMessage(s) -/* Term YapSetOutputMessage() */ -extern X_API int PROTO(YapStreamToFileNo,(Term)); -#ifdef IndirectCalls -static void (*YapIStreamToFileNo)() = YapStreamToFileNo; -#define YapStreamToFileNo() (*YapIStreamToFileNo)() -#endif +/* YAP_Term YAP_SetOutputMessage() */ +#define YapStreamToFileNo(st) YAP_StreamToFileNo(st) -/* Term YapSetOutputMessage() */ -extern X_API void PROTO(YapCloseAllOpenStreams,(void)); -#ifdef IndirectCalls -static void (*YapICloseAllOpenStreams)() = YapCloseAllOpenStreams; -#define YapCloseAllOpenStreams() (*YapICloseAllOpenStreams)() -#endif +/* YAP_Term YAP_SetOutputMessage() */ +#define YapCloseAllOpenStreams() YAP_CloseAllOpenStreams() -#define YAP_INPUT_STREAM 0x01 -#define YAP_OUTPUT_STREAM 0x02 -#define YAP_APPEND_STREAM 0x04 -#define YAP_PIPE_STREAM 0x08 -#define YAP_TTY_STREAM 0x10 -#define YAP_POPEN_STREAM 0x20 -#define YAP_BINARY_STREAM 0x40 -#define YAP_SEEKABLE_STREAM 0x80 - -/* Term YapOpenStream() */ -extern X_API Term PROTO(YapOpenStream,(void *, char *, Term, int)); -#ifdef IndirectCalls -static Term (*YapIOpenStream)() = YapOpenStream; -#define YapOpenStream(FD,S,T,FL) (*YapIOpenStream)(FD,S,T,FL) -#endif - -/* Term *YapNewSlots() */ -extern X_API long PROTO(YapNewSlots,(int)); -#ifdef IndirectCalls -static long (*YapINewSlots)(N) = YapNewSlots; -#define YapNewSlots(N) (*YapINewSlots)(N) -#endif - -/* Term *YapInitSlot() */ -extern X_API long PROTO(YapInitSlot,(Term)); -#ifdef IndirectCalls -static long (*YapIInitSlot)(T) = YapInitSlot; -#define YapInitSlot(T) (*YapIInitSlot)(T) -#endif - -/* Term YapGetFromSlots(t) */ -extern X_API Term PROTO(YapGetFromSlot,(long)); -#ifdef IndirectCalls -static Term (*YapIGetFromSlot)(N) = YapGetFromSlot; -#define YapGetFromSlot(N) (*YapIGetFromSlot)(N) -#endif - -/* Term YapAddressFromSlots(t) */ -extern X_API Term *PROTO(YapAddressFromSlot,(long)); -#ifdef IndirectCalls -static Term *(*YapIAddressFromSlot)(N) = YapAddressFromSlot; -#define YapAddressFromSlot(N) (*YapIAddressFromSlot)(N) -#endif - -/* Term YapPutInSlots(t) */ -extern X_API void PROTO(YapPutInSlot,(long, Term)); -#ifdef IndirectCalls -static void (*YapIPutInSlot)(N,T) = YapPutInSlot; -#define YapPutInSlot(N,T) (*YapIPutInSlot)(N,T) -#endif - -/* void YapRecoverSlots() */ -extern X_API void PROTO(YapRecoverSlots,(int)); -#ifdef IndirectCalls -static void (*YapIRecoverSlots)(N) = YapRecoverSlots; -#define YapRecoverSlots(N) (*YapIRecoverSlots)(N) -#endif - -/* void YapThrow() */ -extern X_API void PROTO(YapThrow,(Term)); -#ifdef IndirectCalls -static void (*YapIThrow)(T) = YapThrow; -#define YapThrow(T) (*YapIThrow)(T) -#endif - -/* int YapLookupModule() */ -extern X_API int PROTO(YapLookupModule,(Term)); -#ifdef IndirectCalls -static int (*YapILookupModule)(T) = YapLookupModule; -#define YapLookupModule(T) (*YapILookupModule)(T) -#endif - -/* int YapModuleName() */ -extern X_API Term PROTO(YapModuleName,(int)); -#ifdef IndirectCalls -static int (*YapIModuleName)(I) = YapModuleName; -#define YapModuleName(I) (*YapIModuleName)(I) -#endif - -/* int YapHalt() */ -extern X_API int PROTO(YapHalt,(int)); -#ifdef IndirectCalls -static int (*YapIHalt)(E) = YapHalt; -#define YapHalt(E) (*YapIHalt)(E) -#endif - -/* int YapTopOfLocalStack() */ -extern X_API Term *PROTO(YapTopOfLocalStack,(void)); -#ifdef IndirectCalls -static Term *(*YapITopOfLocalStack)() = YapTopOfLocalStack; -#define YapTopOfLocalStack() (*YapITopOfLocalStack)() -#endif - -/* int YapPredicate() */ -extern X_API void *PROTO(YapPredicate,(Atom,Int,Int)); -#ifdef IndirectCalls -static Term *(*YapIPredicate)(N,A,M) = YapPredicate; -#define YapPredicate(N,A,M) (*YapIPredicate)(N,A,M) -#endif - -/* int YapPredicate() */ -extern X_API void PROTO(YapPredicateInfo,(void *,Atom*,Int*,Int*)); -#ifdef IndirectCalls -static void (*YapIPredicateInfo)(P,N,A,M) = YapPredicateInfo; -#define YapPredicateInfo(P,N,A,M) (*YapIPredicateInfo)(P,N,A,M) -#endif - - -/* int YapPredicate() */ -extern X_API int PROTO(YapCurrentModule,(void)); -#ifdef IndirectCalls -static int (*YapICurrentModule)() = YapCurrentModule; -#define YapCurrentModule() (*YapICurrentModule)() -#endif - - -#define InitCPred(N,A,F) UserCPredicate(N,F,A) - -__END_DECLS +/* YAP_Term YAP_OpenStream() */ +#define YapOpenStream(st, s, t, i) YAP_OpenStream(st, s, t, i) #endif - diff --git a/include/yap_structs.h b/include/yap_structs.h index a3e2e4729..9a88bb08a 100644 --- a/include/yap_structs.h +++ b/include/yap_structs.h @@ -28,19 +28,15 @@ /* Type definitions */ -typedef unsigned long CELL; /* this is common to all current machines */ +typedef unsigned long YAP_CELL; /* this is common to all current machines */ -typedef int Bool; +typedef int YAP_Bool; -typedef long int Int; +typedef YAP_CELL YAP_Term; -typedef double flt; +typedef struct FunctorEntry *YAP_Functor; -typedef CELL Term; - -typedef struct FunctorEntry *Functor; - -typedef struct AtomEntry *Atom; +typedef struct AtomEntry *YAP_Atom; #ifndef TRUE #define TRUE 1 @@ -93,5 +89,5 @@ typedef struct { int Argc; /* array of arguments as seen by Prolog */ char **Argv; -} yap_init_args; +} YAP_init_args; diff --git a/library/random/random.c b/library/random/random.c index d2661421b..afb7fb770 100644 --- a/library/random/random.c +++ b/library/random/random.c @@ -16,7 +16,7 @@ *************************************************************************/ #include "config.h" -#include "c_interface.h" +#include "YapInterface.h" #include #if defined(__MINGW32__) || _MSC_VER #include @@ -29,8 +29,8 @@ static short a1 = 27314, b1 = 9213, c1 = 17773; static int p_random(void) { - flt fli; - Int t1, t2, t3; + double fli; + long int t1, t2, t3; t1 = (a1 * 171) % 30269; t2 = (b1 * 172) % 30307; @@ -39,32 +39,32 @@ p_random(void) a1 = t1; b1 = t2; c1 = t3; - return(unify(ARG1, MkFloatTerm(fli-(int)(fli)))); + return(YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli-(int)(fli)))); } static int p_setrand(void) { - a1 = IntOfTerm(ARG1); - b1 = IntOfTerm(ARG2); - c1 = IntOfTerm(ARG3); + a1 = YAP_IntOfTerm(YAP_ARG1); + b1 = YAP_IntOfTerm(YAP_ARG2); + c1 = YAP_IntOfTerm(YAP_ARG3); return(TRUE); } static int p_getrand(void) { - return(unify(ARG1,MkIntTerm(a1)) && - unify(ARG2,MkIntTerm(b1)) && - unify(ARG3,MkIntTerm(c1))); + return(YAP_Unify(YAP_ARG1,YAP_MkIntTerm(a1)) && + YAP_Unify(YAP_ARG2,YAP_MkIntTerm(b1)) && + YAP_Unify(YAP_ARG3,YAP_MkIntTerm(c1))); } void init_random(void) { - UserCPredicate("random", p_random, 1); - UserCPredicate("setrand", p_setrand, 3); - UserCPredicate("getrand", p_getrand, 3); + YAP_UserCPredicate("random", p_random, 1); + YAP_UserCPredicate("setrand", p_setrand, 3); + YAP_UserCPredicate("getrand", p_getrand, 3); } #ifdef _WIN32 diff --git a/library/regex/regexp.c b/library/regex/regexp.c index a0fde270a..ebef8a537 100644 --- a/library/regex/regexp.c +++ b/library/regex/regexp.c @@ -19,7 +19,7 @@ #if HAVE_SYS_TYPES_H #include #endif -#include "c_interface.h" +#include "YapInterface.h" #if HAVE_REGEX_H #include "regex.h" #define yap_regcomp(A,B,C) regcomp(A,B,C) @@ -36,20 +36,21 @@ void PROTO(init_regexp, (void)); static int check_regexp(void) { - unsigned int buflen = (unsigned int)IntOfTerm(ARG2)+1; - unsigned int sbuflen = (unsigned int)IntOfTerm(ARG4)+1; + unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1; + unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1; char *buf, *sbuf; regex_t reg; int out; - int yap_flags = IntOfTerm(ARG5), regcomp_flags = REG_NOSUB|REG_EXTENDED; + int yap_flags = YAP_IntOfTerm(YAP_ARG5); + int regcomp_flags = REG_NOSUB|REG_EXTENDED; - if ((buf = (char *)AllocSpaceFromYap(buflen)) == NULL) { + if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) { /* early exit */ return(FALSE); } - if (StringToBuffer(ARG1,buf,buflen) == FALSE) { + if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) { /* something went wrong, possibly a type checking error */ - FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(buf); return(FALSE); } if (yap_flags & 1) @@ -57,23 +58,23 @@ static int check_regexp(void) /* cool, now I have my string in the buffer, let's have some fun */ if (yap_regcomp(®,buf, regcomp_flags) != 0) return(FALSE); - if ((sbuf = (char *)AllocSpaceFromYap(sbuflen)) == NULL) { + if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) { /* early exit */ yap_regfree(®); - FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(buf); return(FALSE); } - if (StringToBuffer(ARG3,sbuf,sbuflen) == FALSE) { + if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) { /* something went wrong, possibly a type checking error */ yap_regfree(®); - FreeSpaceFromYap(buf); - FreeSpaceFromYap(sbuf); + YAP_FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(sbuf); return(FALSE); } out = yap_regexec(®,sbuf,0,NULL,0); yap_regfree(®); - FreeSpaceFromYap(buf); - FreeSpaceFromYap(sbuf); + YAP_FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(sbuf); if (out != 0 && out != REG_NOMATCH) { return(FALSE); } @@ -82,23 +83,24 @@ static int check_regexp(void) static int regexp(void) { - unsigned int buflen = (unsigned int)IntOfTerm(ARG2)+1; - unsigned int sbuflen = (unsigned int)IntOfTerm(ARG4)+1; + unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1; + unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1; char *buf, *sbuf; regex_t reg; int out; - Int nmatch = IntOfTerm(ARG7); + long int nmatch = YAP_IntOfTerm(YAP_ARG7); regmatch_t *pmatch; - Term tout; - int yap_flags = IntOfTerm(ARG5), regcomp_flags = REG_EXTENDED; + long int tout; + int yap_flags = YAP_IntOfTerm(YAP_ARG5); + int regcomp_flags = REG_EXTENDED; - if ((buf = (char *)AllocSpaceFromYap(buflen)) == NULL) { + if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) { /* early exit */ return(FALSE); } - if (StringToBuffer(ARG1,buf,buflen) == FALSE) { + if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) { /* something went wrong, possibly a type checking error */ - FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(buf); return(FALSE); } if (yap_flags & 1) @@ -106,62 +108,62 @@ static int regexp(void) /* cool, now I have my string in the buffer, let's have some fun */ if (yap_regcomp(®,buf, regcomp_flags) != 0) return(FALSE); - if ((sbuf = (char *)AllocSpaceFromYap(sbuflen)) == NULL) { + if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) { /* early exit */ yap_regfree(®); - FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(buf); return(FALSE); } - if (StringToBuffer(ARG3,sbuf,sbuflen) == FALSE) { + if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) { /* something went wrong, possibly a type checking error */ yap_regfree(®); - FreeSpaceFromYap(buf); - FreeSpaceFromYap(sbuf); + YAP_FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(sbuf); return(FALSE); } - pmatch = AllocSpaceFromYap(sizeof(regmatch_t)*nmatch); + pmatch = YAP_AllocSpaceFromYap(sizeof(regmatch_t)*nmatch); out = yap_regexec(®,sbuf,(int)nmatch,pmatch,0); if (out == 0) { /* match succeed, let's fill the match in */ - Int i; - Term TNil = MkAtomTerm(LookupAtom("[]")); - Functor FDiff = MkFunctor(LookupAtom("-"),2); + long int i; + YAP_Term TNil = YAP_MkAtomTerm(YAP_LookupAtom("[]")); + YAP_Functor FDiff = YAP_MkFunctor(YAP_LookupAtom("-"),2); - tout = ARG6; + tout = YAP_ARG6; for (i = 0; i < nmatch; i++) { int j; - Term t = TNil; + YAP_Term t = TNil; if (pmatch[i].rm_so == -1) break; if (yap_flags & 2) { - Term to[2]; - to[0] = MkIntTerm(pmatch[i].rm_so); - to[1] = MkIntTerm(pmatch[i].rm_eo); - t = MkApplTerm(FDiff,2,to); + YAP_Term to[2]; + to[0] = YAP_MkIntTerm(pmatch[i].rm_so); + to[1] = YAP_MkIntTerm(pmatch[i].rm_eo); + t = YAP_MkApplTerm(FDiff,2,to); } else { for (j = pmatch[i].rm_eo-1; j >= pmatch[i].rm_so; j--) { - t = MkPairTerm(MkIntTerm(sbuf[j]),t); + t = YAP_MkPairTerm(YAP_MkIntTerm(sbuf[j]),t); } } - unify(t,HeadOfTerm(tout)); - tout = TailOfTerm(tout); + YAP_Unify(t,YAP_HeadOfTerm(tout)); + tout = YAP_TailOfTerm(tout); } } else if (out != REG_NOMATCH) { return(FALSE); } yap_regfree(®); - FreeSpaceFromYap(buf); - FreeSpaceFromYap(sbuf); - FreeSpaceFromYap(pmatch); + YAP_FreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(sbuf); + YAP_FreeSpaceFromYap(pmatch); return(out == 0); } void init_regexp(void) { - UserCPredicate("check_regexp", check_regexp, 5); - UserCPredicate("check_regexp", regexp, 7); + YAP_UserCPredicate("check_regexp", check_regexp, 5); + YAP_UserCPredicate("check_regexp", regexp, 7); } #if defined(_WIN32) || defined(__MINGW32__) diff --git a/library/system/sys.c b/library/system/sys.c index a474c203f..de653a0cb 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -16,7 +16,7 @@ *************************************************************************/ #include "config.h" -#include "c_interface.h" +#include "YapInterface.h" #if STDC_HEADERS #include #endif @@ -70,7 +70,7 @@ void PROTO(init_sys, (void)); #if defined(__MINGW32__) || _MSC_VER -static Term +static YAP_Term WinError(void) { char msg[256]; @@ -79,7 +79,7 @@ WinError(void) NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256, NULL); - return(MkAtomTerm(LookupAtom(msg))); + return(YAP_MkAtomTerm(YAP_LookupAtom(msg))); } #endif @@ -87,34 +87,34 @@ WinError(void) static int datime(void) { - Term tf, out[6]; + YAP_Term tf, out[6]; #if defined(__MINGW32__) || _MSC_VER SYSTEMTIME stime; GetLocalTime(&stime); - out[0] = MkIntTerm(stime.wYear); - out[1] = MkIntTerm(stime.wMonth); - out[2] = MkIntTerm(stime.wDay); - out[3] = MkIntTerm(stime.wHour); - out[4] = MkIntTerm(stime.wMinute); - out[5] = MkIntTerm(stime.wSecond); + out[0] = YAP_MkIntTerm(stime.wYear); + out[1] = YAP_MkIntTerm(stime.wMonth); + out[2] = YAP_MkIntTerm(stime.wDay); + out[3] = YAP_MkIntTerm(stime.wHour); + out[4] = YAP_MkIntTerm(stime.wMinute); + out[5] = YAP_MkIntTerm(stime.wSecond); #elif HAVE_TIME time_t tp; if ((tp = time(NULL)) == -1) { - return(unify(ARG2, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); } #ifdef HAVE_LOCALTIME { struct tm *loc = localtime(&tp); if (loc == NULL) { - return(unify(ARG2, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); } - out[0] = MkIntTerm(1900+loc->tm_year); - out[1] = MkIntTerm(1+loc->tm_mon); - out[2] = MkIntTerm(loc->tm_mday); - out[3] = MkIntTerm(loc->tm_hour); - out[4] = MkIntTerm(loc->tm_min); - out[5] = MkIntTerm(loc->tm_sec); + out[0] = YAP_MkIntTerm(1900+loc->tm_year); + out[1] = YAP_MkIntTerm(1+loc->tm_mon); + out[2] = YAP_MkIntTerm(loc->tm_mday); + out[3] = YAP_MkIntTerm(loc->tm_hour); + out[4] = YAP_MkIntTerm(loc->tm_min); + out[5] = YAP_MkIntTerm(loc->tm_sec); } #else oops @@ -122,8 +122,8 @@ datime(void) #else oops #endif /* HAVE_TIME */ - tf = MkApplTerm(MkFunctor(LookupAtom("datime"),6), 6, out); - return(unify(ARG1, tf)); + tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out); + return(YAP_Unify(YAP_ARG1, tf)); } #define BUF_SIZE 1024 @@ -132,9 +132,9 @@ datime(void) static int list_directory(void) { - Term tf = MkAtomTerm(LookupAtom("[]")); + YAP_Term tf = YAP_MkAtomTerm(YAP_LookupAtom("[]")); - char *buf = AtomName(AtomOfTerm(ARG1)); + char *buf = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if defined(__MINGW32__) || _MSC_VER struct _finddata_t c_file; char bs[BUF_SIZE]; @@ -152,12 +152,12 @@ list_directory(void) strncat(bs, "/*"); #endif if ((hFile = _findfirst(bs, &c_file)) == -1L) { - return(unify(ARG2,tf)); + return(YAP_Unify(YAP_ARG2,tf)); } - tf = MkPairTerm(MkAtomTerm(LookupAtom(c_file.name)), tf); + tf = YAP_MkPairTerm(YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)), tf); while (_findnext( hFile, &c_file) == 0) { - Term ti = MkAtomTerm(LookupAtom(c_file.name)); - tf = MkPairTerm(ti, tf); + YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)); + tf = YAP_MkPairTerm(ti, tf); } _findclose( hFile ); #else @@ -167,23 +167,23 @@ list_directory(void) struct dirent *dp; if ((de = opendir(buf)) == NULL) { - return(unify(ARG3, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); } while ((dp = readdir(de))) { - Term ti = MkAtomTerm(LookupAtom(dp->d_name)); - tf = MkPairTerm(ti, tf); + YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp->d_name)); + tf = YAP_MkPairTerm(ti, tf); } closedir(de); } #endif /* HAVE_OPENDIR */ #endif - return(unify(ARG2, tf)); + return(YAP_Unify(YAP_ARG2, tf)); } static int p_unlink(void) { - char *fd = AtomName(AtomOfTerm(ARG1)); + char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if defined(__MINGW32__) || _MSC_VER if (_unlink(fd) == -1) #else @@ -191,7 +191,7 @@ p_unlink(void) #endif { /* return an error number */ - return(unify(ARG2, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); } return(TRUE); } @@ -199,14 +199,14 @@ p_unlink(void) static int p_mkdir(void) { - char *fd = AtomName(AtomOfTerm(ARG1)); + char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if defined(__MINGW32__) || _MSC_VER if (_mkdir(fd) == -1) { #else if (mkdir(fd, 0777) == -1) { #endif /* return an error number */ - return(unify(ARG2, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); } return(TRUE); } @@ -214,14 +214,14 @@ p_mkdir(void) static int p_rmdir(void) { - char *fd = AtomName(AtomOfTerm(ARG1)); + char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if defined(__MINGW32__) || _MSC_VER if (_rmdir(fd) == -1) { #else if (rmdir(fd) == -1) { #endif /* return an error number */ - return(unify(ARG2, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); } return(TRUE); } @@ -229,12 +229,12 @@ p_rmdir(void) static int rename_file(void) { - char *s1 = AtomName(AtomOfTerm(ARG1)); - char *s2 = AtomName(AtomOfTerm(ARG2)); + char *s1 = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + char *s2 = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)); #if HAVE_RENAME if (rename(s1, s2) == -1) { /* return an error number */ - return(unify(ARG3, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); } #endif return(TRUE); @@ -243,7 +243,7 @@ rename_file(void) static int dir_separator(void) { - return(unify(ARG1,MkAtomTerm(LookupAtom("/")))); + return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/")))); } static int @@ -253,75 +253,75 @@ file_property(void) #if HAVE_LSTAT struct stat buf; - fd = AtomName(AtomOfTerm(ARG1)); + fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); if (lstat(fd, &buf) == -1) { /* return an error number */ - return(unify(ARG7, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); } if (S_ISREG(buf.st_mode)) { - if (!(unify(ARG2, MkAtomTerm(LookupAtom("regular"))) && - unify(ARG6, YapMkIntTerm(0)))) + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) return(FALSE); } else if (S_ISDIR(buf.st_mode)) { - if (!(unify(ARG2, MkAtomTerm(LookupAtom("directory"))) && - unify(ARG6, YapMkIntTerm(0)))) + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) return(FALSE); } else if (S_ISFIFO(buf.st_mode)) { - if (!(unify(ARG2, MkAtomTerm(LookupAtom("fifo"))) && - unify(ARG6, YapMkIntTerm(0)))) + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("fifo"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) return(FALSE); } else if (S_ISLNK(buf.st_mode)) { - if (!unify(ARG2, MkAtomTerm(LookupAtom("symlink")))) + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("symlink")))) return(FALSE); #if HAVE_READLINK { char tmp[256]; int n; if ((n = readlink(fd,tmp,256)) == -1) { - return(unify(ARG7, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); } tmp[n] = '\0'; - if(!unify(ARG6,MkAtomTerm(LookupAtom(tmp)))) { + if(!YAP_Unify(YAP_ARG6,YAP_MkAtomTerm(YAP_LookupAtom(tmp)))) { return(FALSE); } } #else - if (!unify(ARG6, YapMkIntTerm(0))) + if (!YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))) return(FALSE); #endif } else if (S_ISSOCK(buf.st_mode)) { - if (!(unify(ARG2, MkAtomTerm(LookupAtom("socket"))) && - unify(ARG6, YapMkIntTerm(0)))) + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("socket"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) return(FALSE); } else { - if (!(unify(ARG2, MkAtomTerm(LookupAtom("unknown"))) && - unify(ARG6, YapMkIntTerm(0)))) + if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))) && + YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))) return(FALSE); } #elif defined(__MINGW32__) || _MSC_VER /* for some weird reason _stat did not work with mingw32 */ struct stat buf; - fd = AtomName(AtomOfTerm(ARG1)); + fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); if (stat(fd, &buf) != 0) { /* return an error number */ - return(unify(ARG7, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno))); } if (buf.st_mode & S_IFREG) { - if (!unify(ARG2, MkAtomTerm(LookupAtom("regular")))) + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular")))) return(FALSE); } else if (buf.st_mode & S_IFDIR) { - if (!unify(ARG2, MkAtomTerm(LookupAtom("directory")))) + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory")))) return(FALSE); } else { - if (!unify(ARG2, MkAtomTerm(LookupAtom("unknown")))) + if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown")))) return(FALSE); } #endif return ( - unify(ARG3, MkIntTerm(buf.st_size)) && - unify(ARG4, MkIntTerm(buf.st_mtime)) && - unify(ARG5, MkIntTerm(buf.st_mode)) + YAP_Unify(YAP_ARG3, YAP_MkIntTerm(buf.st_size)) && + YAP_Unify(YAP_ARG4, YAP_MkIntTerm(buf.st_mtime)) && + YAP_Unify(YAP_ARG5, YAP_MkIntTerm(buf.st_mode)) ); } @@ -332,7 +332,7 @@ p_mktemp(void) { #if HAVE_MKTEMP char *s, tmp[BUF_SIZE]; - s = AtomName(AtomOfTerm(ARG1)); + s = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if HAVE_STRNCPY strncpy(tmp, s, BUF_SIZE); #else @@ -344,9 +344,9 @@ p_mktemp(void) if ((s = mktemp(tmp)) == NULL) { #endif /* return an error number */ - return(unify(ARG3, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); } - return(unify(ARG2,MkAtomTerm(LookupAtom(s)))); + return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s)))); #else oops #endif @@ -357,7 +357,7 @@ static int p_tpmnam(void) { #if HAVE_TMPNAM - return(unify(ARG1,MkAtomTerm(LookupAtom(tmpnam(NULL))))); + return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(tmpnam(NULL))))); #else oops #endif @@ -373,10 +373,10 @@ p_environ(void) #else extern char **environ; #endif - Term t1 = ARG1; - Int i; + YAP_Term t1 = YAP_ARG1; + long int i; - i = IntOfTerm(t1); + i = YAP_IntOfTerm(t1); #if defined(__MINGW32__) || _MSC_VER if (_environ[i] == NULL) #else @@ -384,20 +384,20 @@ p_environ(void) #endif return(FALSE); else { - Term t = BufferToString(environ[i]); - return(unify(t, ARG2)); + YAP_Term t = YAP_BufferToString(environ[i]); + return(YAP_Unify(t, YAP_ARG2)); } #else - YapError("environ not available in this configuration"); + YAP_Error("environ not available in this configuration"); return(FALSE); #endif } #if defined(__MINGW32__) || _MSC_VER static HANDLE -get_handle(Term ti, DWORD fd) +get_handle(YAP_Term ti, DWORD fd) { - if (IsAtomTerm(ti)) { + if (YAP_IsAtomTerm(ti)) { HANDLE out; SECURITY_ATTRIBUTES satt; @@ -413,17 +413,17 @@ get_handle(Term ti, DWORD fd) NULL); return(out); } else { - if (IsIntTerm(ti)) { + if (YAP_IsIntTerm(ti)) { return(GetStdHandle(fd)); } else - return((HANDLE)YapStreamToFileNo(ti)); + return((HANDLE)YAP_StreamToFileNo(ti)); } } static void -close_handle(Term ti, HANDLE h) +close_handle(YAP_Term ti, HANDLE h) { - if (IsAtomTerm(ti)) { + if (YAP_IsAtomTerm(ti)) { CloseHandle(h); } } @@ -434,7 +434,7 @@ close_handle(Term ti, HANDLE h) static int execute_command(void) { - Term ti = ARG2, to = ARG3, te = ARG4; + YAP_Term ti = YAP_ARG2, to = YAP_ARG3, te = YAP_ARG4; int res; #if defined(__MINGW32__) || _MSC_VER HANDLE inpf, outf, errf; @@ -443,20 +443,20 @@ execute_command(void) PROCESS_INFORMATION ProcessInformation; inpf = get_handle(ti, STD_INPUT_HANDLE); if (inpf == INVALID_HANDLE_VALUE) { - return(unify(ARG6, WinError())); + return(YAP_Unify(YAP_ARG6, WinError())); } outf = get_handle(to, STD_OUTPUT_HANDLE); if (outf == INVALID_HANDLE_VALUE) { close_handle(ti, inpf); - return(unify(ARG6, WinError())); + return(YAP_Unify(YAP_ARG6, WinError())); } errf = get_handle(te, STD_OUTPUT_HANDLE); if (errf == INVALID_HANDLE_VALUE) { close_handle(ti, inpf); close_handle(to, outf); - return(unify(ARG6, WinError())); + return(YAP_Unify(YAP_ARG6, WinError())); } - if (!IsIntTerm(ti) && !IsIntTerm(to) && !IsIntTerm(te)) { + if (!YAP_IsIntTerm(ti) && !YAP_IsIntTerm(to) && !YAP_IsIntTerm(te)) { /* we do not keep a current stream */ CreationFlags = DETACHED_PROCESS; } @@ -472,7 +472,7 @@ execute_command(void) StartupInfo.hStdError = errf; /* got stdin, stdout and error as I like it */ if (CreateProcess(NULL, - AtomName(AtomOfTerm(ARG1)), + YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), NULL, NULL, TRUE, @@ -484,62 +484,62 @@ execute_command(void) close_handle(ti, inpf); close_handle(to, outf); close_handle(te, errf); - return(unify(ARG6, WinError())); + return(YAP_Unify(YAP_ARG6, WinError())); } close_handle(ti, inpf); close_handle(to, outf); close_handle(te, errf); res = ProcessInformation.dwProcessId; - return(unify(ARG5,MkIntTerm(res))); + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res))); #else /* UNIX CODE */ int inpf, outf, errf; /* process input first */ - if (IsAtomTerm(ti)) { + if (YAP_IsAtomTerm(ti)) { inpf = open("/dev/null", O_RDONLY); } else { int sd; - if (IsIntTerm(ti)) + if (YAP_IsIntTerm(ti)) sd = 0; else - sd = YapStreamToFileNo(ti); + sd = YAP_StreamToFileNo(ti); inpf = dup(sd); } if (inpf < 0) { /* return an error number */ - return(unify(ARG6, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); } /* then output stream */ - if (IsAtomTerm(to)) { + if (YAP_IsAtomTerm(to)) { outf = open("/dev/zero", O_WRONLY); } else { int sd; - if (IsIntTerm(to)) + if (YAP_IsIntTerm(to)) sd = 1; else - sd = YapStreamToFileNo(to); + sd = YAP_StreamToFileNo(to); outf = dup(sd); } if (outf < 0) { /* return an error number */ close(inpf); - return(unify(ARG6, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); } /* then error stream */ - if (IsAtomTerm(te)) { + if (YAP_IsAtomTerm(te)) { errf = open("/dev/zero", O_WRONLY); } else { int sd; - if (IsIntTerm(te)) + if (YAP_IsIntTerm(te)) sd = 2; else - sd = YapStreamToFileNo(te); + sd = YAP_StreamToFileNo(te); errf = dup(sd); } if (errf < 0) { /* return an error number */ close(inpf); close(outf); - return(unify(ARG6, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); } /* we are now ready to fork */ if ((res = fork()) < 0) { @@ -548,13 +548,13 @@ execute_command(void) close(outf); close(errf); /* return an error number */ - return(unify(ARG6, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); } else if (res == 0) { char *argv[4]; /* child */ /* close current streams, but not std streams */ - YapCloseAllOpenStreams(); + YAP_CloseAllOpenStreams(); close(0); dup(inpf); close(inpf); @@ -566,7 +566,7 @@ execute_command(void) close(errf); argv[0] = "sh"; argv[1] = "-c"; - argv[2] = AtomName(AtomOfTerm(ARG1)); + argv[2] = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); argv[3] = NULL; execv("/bin/sh", argv); exit(127); @@ -575,7 +575,7 @@ execute_command(void) close(inpf); close(outf); close(errf); - return(unify(ARG5,MkIntTerm(res))); + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res))); } #endif /* UNIX code */ } @@ -584,15 +584,15 @@ execute_command(void) static int do_system(void) { - char *command = AtomName(AtomOfTerm(ARG1)); + char *command = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if HAVE_SYSTEM int sys = system(command); if (sys < 0) { - return(unify(ARG3,MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG3,YAP_MkIntTerm(errno))); } - return(unify(ARG2, MkIntTerm(sys))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(sys))); #else - YapError("system not available in this configuration"); + YAP_Error("system not available in this configuration"); return(FALSE); #endif } @@ -604,35 +604,35 @@ static int do_shell(void) { #if defined(__MINGW32__) || _MSC_VER - char *buf = YapAllocSpaceFromYap(BUF_SIZE); + char *buf = YAP_AllocSpaceFromYap(BUF_SIZE); int sys; if (buf == NULL) { - YapError("No Temporary Space for Shell"); + YAP_Error("No Temporary Space for Shell"); return(FALSE); } #if HAVE_STRNCPY - strncpy(YapAtomName(AtomOfTerm(ARG1)), buf, BUF_SIZE); + strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), buf, BUF_SIZE); strncpy(" ", buf, BUF_SIZE); - strncpy(YapAtomName(AtomOfTerm(ARG2)), buf, BUF_SIZE); + strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), buf, BUF_SIZE); strncpy(" ", buf, BUF_SIZE); - strncpy(YapAtomName(AtomOfTerm(ARG3)), buf, BUF_SIZE); + strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), buf, BUF_SIZE); #else - strcpy(YapAtomName(AtomOfTerm(ARG1)), buf); + strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), buf); strcpy(" ", buf); - strcpy(YapAtomName(AtomOfTerm(ARG2)), buf); + strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), buf); strcpy(" ", buf); - strcpy(YapAtomName(AtomOfTerm(ARG3)), buf); + strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), buf); #endif #if HAVE_SYSTEM sys = system(buf); - YapFreeSpaceFromYap(buf); + YAP_FreeSpaceFromYap(buf); if (sys < 0) { - return(unify(ARG5,MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno))); } - return(unify(ARG4, MkIntTerm(sys))); + return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys))); #else - YapError("system not available in this configuration"); + YAP_Error("system not available in this configuration"); return(FALSE); #endif #else @@ -640,23 +640,23 @@ do_shell(void) int t; int sys; - cptr[0]= YapAtomName(AtomOfTerm(ARG1)); - cptr[1]= YapAtomName(AtomOfTerm(ARG2)); - cptr[2]= YapAtomName(AtomOfTerm(ARG3)); + cptr[0]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + cptr[1]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)); + cptr[2]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)); cptr[3]= NULL; t = fork(); if (t < 0) { - return(unify(ARG5,MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno))); } else if (t == 0) { - t = execvp(YapAtomName(AtomOfTerm(ARG1)),cptr); + t = execvp(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)),cptr); return(t); } else { t = wait(&sys); if (t < 0) { - return(unify(ARG5,MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno))); } } - return(unify(ARG4, MkIntTerm(sys))); + return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys))); #endif } @@ -664,21 +664,21 @@ do_shell(void) static int p_wait(void) { - Int pid = IntOfTerm(ARG1); + long int pid = YAP_IntOfTerm(YAP_ARG1); #if defined(__MINGW32__) || _MSC_VER HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid); DWORD ExitCode; if (proc == NULL) { - return(unify(ARG3, WinError())); + return(YAP_Unify(YAP_ARG3, WinError())); } if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) { - return(unify(ARG3, WinError())); + return(YAP_Unify(YAP_ARG3, WinError())); } if (GetExitCodeProcess(proc, &ExitCode) == 0) { - return(unify(ARG3, WinError())); + return(YAP_Unify(YAP_ARG3, WinError())); } CloseHandle(proc); - return(unify(ARG2, MkIntTerm(ExitCode))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(ExitCode))); #else do { int status; @@ -687,9 +687,9 @@ p_wait(void) if (waitpid(pid, &status, 0) == -1) { if (errno != EINTR) return -1; - return(unify(ARG3, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); } else { - return(unify(ARG2, MkIntTerm(status))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(status))); } } while(TRUE); #endif @@ -699,10 +699,10 @@ p_wait(void) static int p_popen(void) { - char *command = AtomName(AtomOfTerm(ARG1)); - Int mode = IntOfTerm(ARG2); + char *command = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); + long int mode = YAP_IntOfTerm(YAP_ARG2); FILE *pfd; - Term tsno; + YAP_Term tsno; int flags; #if HAVE_POPEN @@ -719,29 +719,29 @@ p_popen(void) pfd = popen(command, "w"); #endif if (pfd == NULL) { - return(unify(ARG4, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(errno))); } if (mode == 0) flags = YAP_INPUT_STREAM | YAP_POPEN_STREAM; else flags = YAP_OUTPUT_STREAM | YAP_POPEN_STREAM; - tsno = YapOpenStream((void *)pfd, + tsno = YAP_OpenStream((void *)pfd, "pipe", - MkAtomTerm(LookupAtom("pipe")), + YAP_MkAtomTerm(YAP_LookupAtom("pipe")), flags); #endif - return(unify(ARG3, tsno)); + return(YAP_Unify(YAP_ARG3, tsno)); } static int p_sleep(void) { - Term ts = ARG1; - Int secs = 0, usecs = 0, out; - if (IsIntTerm(ts)) { - secs = IntOfTerm(ts); - } else if (IsFloatTerm(ts)) { - flt tfl = FloatOfTerm(ts); + YAP_Term ts = YAP_ARG1; + long int secs = 0, usecs = 0, out; + if (YAP_IsIntTerm(ts)) { + secs = YAP_IntOfTerm(ts); + } else if (YAP_IsFloatTerm(ts)) { + double tfl = YAP_FloatOfTerm(ts); if (tfl > 1.0) secs = tfl; else @@ -764,7 +764,7 @@ p_sleep(void) } #endif #endif /* defined(__MINGW32__) || _MSC_VER */ - return(unify(ARG2, MkIntTerm(out))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out))); } /* host info */ @@ -776,27 +776,27 @@ host_name(void) char name[MAX_COMPUTERNAME_LENGTH+1]; DWORD nSize = MAX_COMPUTERNAME_LENGTH+1; if (GetComputerName(name, &nSize) == 0) { - return(unify(ARG2, WinError())); + return(YAP_Unify(YAP_ARG2, WinError())); } #else #if HAVE_GETHOSTNAME char name[256]; if (gethostname(name, 256) == -1) { /* return an error number */ - return(unify(ARG2, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno))); } #endif #endif /* defined(__MINGW32__) || _MSC_VER */ - return(unify(ARG1, MkAtomTerm(LookupAtom(name)))); + return(YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(name)))); } static int host_id(void) { #if HAVE_GETHOSTID - return(unify(ARG1, MkIntTerm(gethostid()))); + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(gethostid()))); #else - return(unify(ARG1, MkIntTerm(0))); + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(0))); #endif } @@ -804,9 +804,9 @@ static int pid(void) { #if defined(__MINGW32__) || _MSC_VER - return(unify(ARG1, MkIntTerm(_getpid()))); + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(_getpid()))); #else - return(unify(ARG1, MkIntTerm(getpid()))); + return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(getpid()))); #endif } @@ -827,18 +827,18 @@ p_kill(void) /* Windows does not support cross-process signals, so we shall do the SICStus thing and assume that a signal to a process will always kill it */ - HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, IntOfTerm(ARG1)); + HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, YAP_IntOfTerm(YAP_ARG1)); if (proc == NULL) { - return(unify(ARG3, WinError())); + return(YAP_Unify(YAP_ARG3, WinError())); } if (TerminateProcess(proc, -1) == 0) { - return(unify(ARG3, WinError())); + return(YAP_Unify(YAP_ARG3, WinError())); } CloseHandle(proc); #else - if (kill(IntOfTerm(ARG1), IntOfTerm(ARG2)) < 0) { + if (kill(YAP_IntOfTerm(YAP_ARG1), YAP_IntOfTerm(YAP_ARG2)) < 0) { /* return an error number */ - return(unify(ARG3, MkIntTerm(errno))); + return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno))); } #endif /* defined(__MINGW32__) || _MSC_VER */ return(TRUE); @@ -848,10 +848,10 @@ static int error_message(void) { #if HAVE_STRERROR - return(unify(ARG2,MkAtomTerm(LookupAtom(strerror(IntOfTerm(ARG1)))))); + return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(strerror(YAP_IntOfTerm(YAP_ARG1)))))); #else #if HAVE_STRERROR - return(unify(ARG2,ARG1)); + return(YAP_Unify(YAP_ARG2,YAP_ARG1)); #endif #endif } @@ -859,29 +859,29 @@ error_message(void) void init_sys(void) { - UserCPredicate("datime", datime, 2); - UserCPredicate("list_directory", list_directory, 3); - UserCPredicate("file_property", file_property, 7); - UserCPredicate("unlink", p_unlink, 2); - UserCPredicate("mkdir", p_mkdir, 2); - UserCPredicate("rmdir", p_rmdir, 2); - UserCPredicate("dir_separator", dir_separator, 1); - UserCPredicate("p_environ", p_environ, 2); - UserCPredicate("exec_command", execute_command, 6); - UserCPredicate("do_shell", do_shell, 5); - UserCPredicate("do_system", do_system, 3); - UserCPredicate("popen", p_popen, 4); - UserCPredicate("wait", p_wait, 3); - UserCPredicate("host_name", host_name, 2); - UserCPredicate("host_id", host_id, 2); - UserCPredicate("pid", pid, 2); - UserCPredicate("kill", p_kill, 3); - UserCPredicate("mktemp", p_mktemp, 3); - UserCPredicate("tmpnam", p_tpmnam, 2); - UserCPredicate("rename_file", rename_file, 3); - UserCPredicate("sleep", p_sleep, 2); - UserCPredicate("error_message", error_message, 2); - UserCPredicate("win", win, 0); + YAP_UserCPredicate("datime", datime, 2); + YAP_UserCPredicate("list_directory", list_directory, 3); + YAP_UserCPredicate("file_property", file_property, 7); + YAP_UserCPredicate("unlink", p_unlink, 2); + YAP_UserCPredicate("mkdir", p_mkdir, 2); + YAP_UserCPredicate("rmdir", p_rmdir, 2); + YAP_UserCPredicate("dir_separator", dir_separator, 1); + YAP_UserCPredicate("p_environ", p_environ, 2); + YAP_UserCPredicate("exec_command", execute_command, 6); + YAP_UserCPredicate("do_shell", do_shell, 5); + YAP_UserCPredicate("do_system", do_system, 3); + YAP_UserCPredicate("popen", p_popen, 4); + YAP_UserCPredicate("wait", p_wait, 3); + YAP_UserCPredicate("host_name", host_name, 2); + YAP_UserCPredicate("host_id", host_id, 2); + YAP_UserCPredicate("pid", pid, 2); + YAP_UserCPredicate("kill", p_kill, 3); + YAP_UserCPredicate("mktemp", p_mktemp, 3); + YAP_UserCPredicate("tmpnam", p_tpmnam, 2); + YAP_UserCPredicate("rename_file", rename_file, 3); + YAP_UserCPredicate("sleep", p_sleep, 2); + YAP_UserCPredicate("error_message", error_message, 2); + YAP_UserCPredicate("win", win, 0); } #ifdef _WIN32 diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index d4a2a93ef..20492f23d 100644 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -46,7 +46,7 @@ PL_agc_hook(PL_agc_hook_t entry) YAP: char* AtomName(Atom) */ X_API char* PL_atom_chars(atom_t a) /* SAM check type */ { - return YapAtomName(a); + return YAP_AtomName(a); } @@ -55,60 +55,60 @@ X_API char* PL_atom_chars(atom_t a) /* SAM check type */ /* SAM TO DO */ X_API term_t PL_copy_term_ref(term_t from) { - return YapInitSlot(YapGetFromSlot(from)); + return YAP_InitSlot(YAP_GetFromSlot(from)); } X_API term_t PL_new_term_ref(void) { - term_t to = YapNewSlots(1); + term_t to = YAP_NewSlots(1); return to; } X_API term_t PL_new_term_refs(int n) { - term_t to = YapNewSlots(n); + term_t to = YAP_NewSlots(n); return to; } X_API void PL_reset_term_refs(term_t after) { - term_t new = YapNewSlots(1); - YapRecoverSlots(after-new); + term_t new = YAP_NewSlots(1); + YAP_RecoverSlots(after-new); } /* begin PL_get_* functions =============================*/ /* SWI: int PL_get_arg(int index, term_t t, term_t a) - YAP: Term ArgOfTerm(int argno, Term t)*/ + YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/ X_API int PL_get_arg(int index, term_t ts, term_t a) { - Term t = YapGetFromSlot(ts); - if ( !IsApplTerm(t) ) { - if (IsPairTerm(t)) { + YAP_Term t = YAP_GetFromSlot(ts); + if ( !YAP_IsApplTerm(t) ) { + if (YAP_IsPairTerm(t)) { if (index == 1){ - YapPutInSlot(a,HeadOfTerm(t)); + YAP_PutInSlot(a,YAP_HeadOfTerm(t)); return 1; } else if (index == 2) { - YapPutInSlot(a,TailOfTerm(t)); + YAP_PutInSlot(a,YAP_TailOfTerm(t)); return 1; } } return 0; } - YapPutInSlot(a,ArgOfTerm(index, t)); + YAP_PutInSlot(a,YAP_ArgOfTerm(index, t)); return 1; } -/* SWI: int PL_get_atom(term_t t, Atom *a) - YAP: Atom AtomOfTerm(Term) */ +/* SWI: int PL_get_atom(term_t t, YAP_Atom *a) + YAP: YAP_Atom YAP_AtomOfTerm(Term) */ X_API int PL_get_atom(term_t ts, atom_t *a) { - Term t = YapGetFromSlot(ts); - if ( !IsAtomTerm(t)) + YAP_Term t = YAP_GetFromSlot(ts); + if ( !YAP_IsAtomTerm(t)) return 0; - *a = YapAtomOfTerm(t); + *a = YAP_AtomOfTerm(t); return 1; } @@ -116,10 +116,10 @@ X_API int PL_get_atom(term_t ts, atom_t *a) YAP: char* AtomName(Atom) */ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */ { - Term t = YapGetFromSlot(ts); - if (!IsAtomTerm(t)) + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsAtomTerm(t)) return 0; - *a = YapAtomName(YapAtomOfTerm(t)); + *a = YAP_AtomName(YAP_AtomOfTerm(t)); return 1; } @@ -149,25 +149,25 @@ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */ BUF_MALLOC Data is copied to a new buffer returned by malloc(3) */ -static int CvtToStringTerm(Term t, char *buf, char *buf_max) +static int CvtToStringTerm(YAP_Term t, char *buf, char *buf_max) { *buf++ = '\"'; - while (IsPairTerm(t)) { - Term hd = YapHeadOfTerm(t); - Int i; - if (!IsIntTerm(hd)) + while (YAP_IsPairTerm(t)) { + YAP_Term hd = YAP_HeadOfTerm(t); + long int i; + if (!YAP_IsIntTerm(hd)) return 0; - i = IntOfTerm(hd); + i = YAP_IntOfTerm(hd); if (i <= 0 || i >= 255) return 0; - if (!IsIntTerm(hd)) + if (!YAP_IsIntTerm(hd)) return 0; *buf++ = i; if (buf == buf_max) return 0; - t = TailOfTerm(t); + t = YAP_TailOfTerm(t); } - if (t != MkAtomTerm(LookupAtom("[]"))) + if (t != YAP_MkAtomTerm(YAP_LookupAtom("[]"))) return 0; if (buf+1 == buf_max) return 0; @@ -194,7 +194,7 @@ buf_writer(int c) X_API int PL_get_chars(term_t l, char **sp, unsigned flags) { - Term t = YapGetFromSlot(l); + YAP_Term t = YAP_GetFromSlot(l); char *tmp; if (!(flags & BUF_RING)) { @@ -203,26 +203,26 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags) tmp = buffers; } *sp = tmp; - if (YapIsAtomTerm(t)) { + if (YAP_IsAtomTerm(t)) { if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_ALL))) return 0; - *sp = YapAtomName(YapAtomOfTerm(t)); + *sp = YAP_AtomName(YAP_AtomOfTerm(t)); return 1; - } else if (YapIsIntTerm(t)) { + } else if (YAP_IsIntTerm(t)) { if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_ALL))) return 0; - snprintf(tmp,BUF_SIZE,"%ld",IntOfTerm(t)); - } else if (YapIsFloatTerm(t)) { + snprintf(tmp,BUF_SIZE,"%ld",YAP_IntOfTerm(t)); + } else if (YAP_IsFloatTerm(t)) { if (!(flags & (CVT_FLOAT|CVT_ATOMIC|CVT_NUMBER|CVT_ALL))) return 0; - snprintf(tmp,BUF_SIZE,"%f",FloatOfTerm(t)); + snprintf(tmp,BUF_SIZE,"%f",YAP_FloatOfTerm(t)); } else if (flags & CVT_STRING) { if (CvtToStringTerm(t,tmp,tmp+BUF_SIZE) == 0) return 0; } else { bf = tmp; bf_lim = tmp+(BUF_SIZE-1); - YapWrite(t,buf_writer,0); + YAP_Write(t,buf_writer,0); if (bf == bf_lim) return 0; *bf = '\0'; @@ -238,56 +238,56 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags) } /* SWI: int PL_get_functor(term_t t, functor_t *f) - YAP: Functor FunctorOfTerm(Term) */ + YAP: YAP_Functor YAP_FunctorOfTerm(Term) */ X_API int PL_get_functor(term_t ts, functor_t *f) { - Term t = YapGetFromSlot(ts); - if ( IsAtomTerm(t)) { + YAP_Term t = YAP_GetFromSlot(ts); + if ( YAP_IsAtomTerm(t)) { *f = t; } else { - *f = (functor_t)FunctorOfTerm(t); + *f = (functor_t)YAP_FunctorOfTerm(t); } return 1; } /* SWI: int PL_get_float(term_t t, double *f) - YAP: flt FloatOfTerm(Term) */ + YAP: double YAP_FloatOfTerm(Term) */ X_API int PL_get_float(term_t ts, double *f) /* SAM type check*/ { - Term t = YapGetFromSlot(ts); - if ( !IsFloatTerm(t)) + YAP_Term t = YAP_GetFromSlot(ts); + if ( !YAP_IsFloatTerm(t)) return 0; - *f = FloatOfTerm(t); + *f = YAP_FloatOfTerm(t); return 1; } X_API int PL_get_head(term_t ts, term_t h) { - Term t = YapGetFromSlot(ts); - if (!IsPairTerm(t) ) { + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsPairTerm(t) ) { return 0; } - YapPutInSlot(h,HeadOfTerm(t)); + YAP_PutInSlot(h,YAP_HeadOfTerm(t)); return 1; } /* SWI: int PL_get_integer(term_t t, int *i) - YAP: Int IntOfTerm(Term) */ + YAP: long int YAP_IntOfTerm(Term) */ X_API int PL_get_integer(term_t ts, int *i) { - Term t = YapGetFromSlot(ts); - if (!IsIntTerm(t) ) + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsIntTerm(t) ) return 0; - *i = IntOfTerm(t); + *i = YAP_IntOfTerm(t); return 1; } X_API int PL_get_long(term_t ts, long *i) { - Term t = YapGetFromSlot(ts); - if (!IsIntTerm(t) ) { - if (IsFloatTerm(t)) { - double dbl = YapFloatOfTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsIntTerm(t) ) { + if (YAP_IsFloatTerm(t)) { + double dbl = YAP_FloatOfTerm(t); if (dbl - (long)dbl == 0.0) { *i = (long)dbl; return 1; @@ -295,18 +295,18 @@ X_API int PL_get_long(term_t ts, long *i) } return 0; } - *i = IntOfTerm(t); + *i = YAP_IntOfTerm(t); return 1; } X_API int PL_get_list(term_t ts, term_t h, term_t tl) { - Term t = YapGetFromSlot(ts); - if (!IsPairTerm(t) ) { + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsPairTerm(t) ) { return 0; } - YapPutInSlot(h,HeadOfTerm(t)); - YapPutInSlot(tl,TailOfTerm(t)); + YAP_PutInSlot(h,YAP_HeadOfTerm(t)); + YAP_PutInSlot(tl,YAP_TailOfTerm(t)); return 1; } @@ -320,43 +320,43 @@ X_API int PL_get_list_chars(term_t l, char **sp, unsigned flags) /* SWI: int PL_get_module(term_t t, module_t *m) */ X_API int PL_get_module(term_t ts, module_t *m) { - Term t = YapGetFromSlot(ts); - if (!YapIsAtomTerm(t) ) + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsAtomTerm(t) ) return 0; - *m = YapLookupModule(t); + *m = YAP_LookupModule(t); return 1; } -/* SWI: int PL_get_atom(term_t t, Atom *a) - YAP: Atom AtomOfTerm(Term) */ +/* SWI: int PL_get_atom(term_t t, YAP_Atom *a) + YAP: YAP_Atom YAP_AtomOfTerm(Term) */ X_API int PL_get_name_arity(term_t ts, atom_t *name, int *arity) { - Term t = YapGetFromSlot(ts); - if (YapIsAtomTerm(t)) { - *name = YapAtomOfTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + if (YAP_IsAtomTerm(t)) { + *name = YAP_AtomOfTerm(t); *arity = 0; return 1; } - if (YapIsApplTerm(t)) { - Functor f = YapFunctorOfTerm(t); - *name = YapNameOfFunctor(f); - *arity = YapArityOfFunctor(f); + if (YAP_IsApplTerm(t)) { + YAP_Functor f = YAP_FunctorOfTerm(t); + *name = YAP_NameOfFunctor(f); + *arity = YAP_ArityOfFunctor(f); return 1; } - if (YapIsPairTerm(t)) { - *name = YapLookupAtom("."); + if (YAP_IsPairTerm(t)) { + *name = YAP_LookupAtom("."); *arity = 2; return 1; } return 0; } -/* SWI: int PL_get_atom(term_t t, Atom *a) - YAP: Atom AtomOfTerm(Term) */ +/* SWI: int PL_get_atom(term_t t, YAP_Atom *a) + YAP: YAP_Atom YAP_AtomOfTerm(Term) */ X_API int PL_get_nil(term_t ts) { - Term t = YapGetFromSlot(ts); - return ( t == YapMkAtomTerm(YapLookupAtom("[]"))); + YAP_Term t = YAP_GetFromSlot(ts); + return ( t == YAP_MkAtomTerm(YAP_LookupAtom("[]"))); } /* SWI: int PL_get_pointer(term_t t, int *i) @@ -364,10 +364,10 @@ X_API int PL_get_nil(term_t ts) /* SAM TO DO */ X_API int PL_get_pointer(term_t ts, void **i) { - Term t = YapGetFromSlot(ts); - if (!IsIntTerm(t) ) + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsIntTerm(t) ) return 0; - *i = (void *)YapIntOfTerm(t); + *i = (void *)YAP_IntOfTerm(t); return 1; } @@ -375,15 +375,15 @@ X_API int PL_get_pointer(term_t ts, void **i) YAP: char* AtomName(Atom) */ X_API int PL_get_string(term_t ts, char **sp, int *lenp) /* SAM check type */ { - Term t = YapGetFromSlot(ts); + YAP_Term t = YAP_GetFromSlot(ts); char *to; int len; - if (!IsPairTerm(t)) + if (!YAP_IsPairTerm(t)) return 0; - if (!YapStringToBuffer(t, buffers, TMP_BUF_SIZE)) + if (!YAP_StringToBuffer(t, buffers, TMP_BUF_SIZE)) return(FALSE); len = strlen(buffers); - to = (char *)YapNewSlots((len/sizeof(Term))+1); + to = (char *)YAP_NewSlots((len/sizeof(YAP_Term))+1); strncpy(to, buffers, TMP_BUF_SIZE); *sp = to; return 1; @@ -391,11 +391,11 @@ X_API int PL_get_string(term_t ts, char **sp, int *lenp) /* SAM check type */ X_API int PL_get_tail(term_t ts, term_t tl) { - Term t = YapGetFromSlot(ts); - if (!IsPairTerm(t) ) { + YAP_Term t = YAP_GetFromSlot(ts); + if (!YAP_IsPairTerm(t) ) { return 0; } - YapPutInSlot(tl,TailOfTerm(t)); + YAP_PutInSlot(tl,YAP_TailOfTerm(t)); return 1; } @@ -404,41 +404,41 @@ X_API int PL_get_tail(term_t ts, term_t tl) /* begin PL_new_* functions =============================*/ /* SWI: atom_t PL_new_atom(const char *) - YAP: Atom LookupAtom(char *) */ + YAP: YAP_Atom LookupAtom(char *) */ /* SAM should the following be used instead? - Atom FullLookupAtom(char *) + YAP_Atom FullLookupAtom(char *) */ X_API atom_t PL_new_atom(const char *c) { - return YapLookupAtom((char *)c); + return YAP_LookupAtom((char *)c); } X_API functor_t PL_new_functor(atom_t name, int arity) { functor_t f; if (arity == 0) { - f = (functor_t)YapMkAtomTerm(name); + f = (functor_t)YAP_MkAtomTerm(name); } else { - f = (functor_t)YapMkFunctor(name,arity); + f = (functor_t)YAP_MkFunctor(name,arity); } return f; } X_API atom_t PL_functor_name(functor_t f) { - if (IsAtomTerm(f)) { - return AtomOfTerm(f); + if (YAP_IsAtomTerm(f)) { + return YAP_AtomOfTerm(f); } else { - return YapNameOfFunctor((Functor)f); + return YAP_NameOfFunctor((YAP_Functor)f); } } X_API int PL_functor_arity(functor_t f) { - if (IsAtomTerm(f)) { + if (YAP_IsAtomTerm(f)) { return 0; } else { - return YapArityOfFunctor((Functor)f); + return YAP_ArityOfFunctor((YAP_Functor)f); } } @@ -450,90 +450,90 @@ X_API void PL_cons_functor(term_t d, functor_t f,...) { va_list ap; int arity, i; - Term *tmp = (CELL *)buffers; + YAP_Term *tmp = (YAP_CELL *)buffers; - if (IsAtomTerm((Term)f)) { - YapPutInSlot(d, (Term)f); + if (YAP_IsAtomTerm((YAP_Term)f)) { + YAP_PutInSlot(d, (YAP_Term)f); return; } - arity = ArityOfFunctor((Functor)f); - if (arity > TMP_BUF_SIZE/sizeof(CELL)) { + arity = YAP_ArityOfFunctor((YAP_Functor)f); + if (arity > TMP_BUF_SIZE/sizeof(YAP_CELL)) { fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity); return; } va_start (ap, f); for (i = 0; i < arity; i++) { - tmp[i] = YapGetFromSlot(va_arg(ap, term_t)); + tmp[i] = YAP_GetFromSlot(va_arg(ap, term_t)); } va_end (ap); - if (arity == 2 && (Functor)f == YapMkFunctor(YapLookupAtom("."),2)) - YapPutInSlot(d,YapMkPairTerm(tmp[0],tmp[1])); + if (arity == 2 && (YAP_Functor)f == YAP_MkFunctor(YAP_LookupAtom("."),2)) + YAP_PutInSlot(d,YAP_MkPairTerm(tmp[0],tmp[1])); else - YapPutInSlot(d,YapMkApplTerm((Functor)f,arity,tmp)); + YAP_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)f,arity,tmp)); } X_API void PL_cons_functor_v(term_t d, functor_t f,term_t a0) { int arity; - if (IsAtomTerm(f)) { - YapPutInSlot(d,(Term)f); + if (YAP_IsAtomTerm(f)) { + YAP_PutInSlot(d,(YAP_Term)f); return; } - arity = ArityOfFunctor((Functor)f); - if (arity == 2 && (Functor)f == YapMkFunctor(YapLookupAtom("."),2)) - YapPutInSlot(d,YapMkPairTerm(YapGetFromSlot(a0),YapGetFromSlot(a0+1))); + arity = YAP_ArityOfFunctor((YAP_Functor)f); + if (arity == 2 && (YAP_Functor)f == YAP_MkFunctor(YAP_LookupAtom("."),2)) + YAP_PutInSlot(d,YAP_MkPairTerm(YAP_GetFromSlot(a0),YAP_GetFromSlot(a0+1))); else - YapPutInSlot(d,YapMkApplTerm((Functor)f,arity,YapAddressFromSlot(a0))); + YAP_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)f,arity,YAP_AddressFromSlot(a0))); } X_API void PL_cons_list(term_t d, term_t h, term_t t) { - YapPutInSlot(d,YapMkPairTerm(YapGetFromSlot(h),YapGetFromSlot(t))); + YAP_PutInSlot(d,YAP_MkPairTerm(YAP_GetFromSlot(h),YAP_GetFromSlot(t))); } X_API void PL_put_atom(term_t t, atom_t a) { - YapPutInSlot(t,YapMkAtomTerm(a)); + YAP_PutInSlot(t,YAP_MkAtomTerm(a)); } X_API void PL_put_atom_chars(term_t t, const char *s) { - YapPutInSlot(t,YapMkAtomTerm(YapLookupAtom((char *)s))); + YAP_PutInSlot(t,YAP_MkAtomTerm(YAP_LookupAtom((char *)s))); } X_API void PL_put_float(term_t t, double fl) { - YapPutInSlot(t,YapMkFloatTerm(fl)); + YAP_PutInSlot(t,YAP_MkFloatTerm(fl)); } X_API void PL_put_functor(term_t t, functor_t f) { - Int arity; - if (IsAtomTerm(f)) { - YapPutInSlot(t,f); + long int arity; + if (YAP_IsAtomTerm(f)) { + YAP_PutInSlot(t,f); } else { - arity = YapArityOfFunctor((Functor)f); - if (arity == 2 && (Functor)f == YapMkFunctor(YapLookupAtom("."),2)) - YapPutInSlot(t,YapMkNewPairTerm()); + arity = YAP_ArityOfFunctor((YAP_Functor)f); + if (arity == 2 && (YAP_Functor)f == YAP_MkFunctor(YAP_LookupAtom("."),2)) + YAP_PutInSlot(t,YAP_MkNewPairTerm()); else - YapPutInSlot(t,MkNewApplTerm((Functor)f,arity)); + YAP_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)f,arity)); } } X_API void PL_put_integer(term_t t, long n) { - YapPutInSlot(t,YapMkIntTerm(n)); + YAP_PutInSlot(t,YAP_MkIntTerm(n)); } X_API void PL_put_list(term_t t) { - YapPutInSlot(t,YapMkNewPairTerm()); + YAP_PutInSlot(t,YAP_MkNewPairTerm()); } X_API void PL_put_nil(term_t t) { - YapPutInSlot(t,MkAtomTerm(LookupAtom("[]"))); + YAP_PutInSlot(t,YAP_MkAtomTerm(YAP_LookupAtom("[]"))); } /* SWI: void PL_put_pointer(term_t -t, void *ptr) @@ -541,23 +541,23 @@ X_API void PL_put_nil(term_t t) /* SAM TO DO */ X_API void PL_put_pointer(term_t t, void *ptr) { - Term tptr = MkIntTerm((Int)ptr); - YapPutInSlot(t,tptr); + YAP_Term tptr = YAP_MkIntTerm((long int)ptr); + YAP_PutInSlot(t,tptr); } X_API void PL_put_string_chars(term_t t, const char *s) { - YapPutInSlot(t,YapBufferToString((char *)s)); + YAP_PutInSlot(t,YAP_BufferToString((char *)s)); } X_API void PL_put_term(term_t d, term_t s) { - YapPutInSlot(d,YapGetFromSlot(s)); + YAP_PutInSlot(d,YAP_GetFromSlot(s)); } X_API void PL_put_variable(term_t t) { - YapPutInSlot(t,MkVarTerm()); + YAP_PutInSlot(t,YAP_MkVarTerm()); } /* end PL_put_* functions =============================*/ @@ -568,7 +568,7 @@ X_API void PL_put_variable(term_t t) X_API int PL_raise_exception(term_t exception) { - YapThrow(YapGetFromSlot(exception)); + YAP_Throw(YAP_GetFromSlot(exception)); return 0; } @@ -576,64 +576,64 @@ X_API int PL_raise_exception(term_t exception) X_API int PL_unify(term_t t1, term_t t2) { - return unify(YapGetFromSlot(t1),YapGetFromSlot(t2)); + return YAP_Unify(YAP_GetFromSlot(t1),YAP_GetFromSlot(t2)); } /* SWI: int PL_unify_atom(term_t ?t, atom *at) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_atom(term_t t, atom_t at) { - Term cterm = MkAtomTerm(at); - return unify(YapGetFromSlot(t),cterm); + YAP_Term cterm = YAP_MkAtomTerm(at); + return YAP_Unify(YAP_GetFromSlot(t),cterm); } /* SWI: int PL_unify_atom_chars(term_t ?t, const char *chars) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_atom_chars(term_t t, const char *s) { - Atom catom = YapLookupAtom((char *)s); - Term cterm = MkAtomTerm(catom); - return unify(YapGetFromSlot(t),cterm); + YAP_Atom catom = YAP_LookupAtom((char *)s); + YAP_Term cterm = YAP_MkAtomTerm(catom); + return YAP_Unify(YAP_GetFromSlot(t),cterm); } /* SWI: int PL_unify_float(term_t ?t, double f) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_float(term_t t, double f) { - Term fterm = MkFloatTerm(f); - return unify(YapGetFromSlot(t),fterm); + YAP_Term fterm = YAP_MkFloatTerm(f); + return YAP_Unify(YAP_GetFromSlot(t),fterm); } /* SWI: int PL_unify_integer(term_t ?t, long n) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_integer(term_t t, long n) { - Term iterm = MkIntTerm(n); - return unify(YapGetFromSlot(t),iterm); + YAP_Term iterm = YAP_MkIntTerm(n); + return YAP_Unify(YAP_GetFromSlot(t),iterm); } /* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_list(term_t t, term_t h, term_t tail) { - Term pairterm = MkPairTerm(YapGetFromSlot(h),YapGetFromSlot(tail)); - return unify(YapGetFromSlot(t), pairterm); + YAP_Term pairterm = YAP_MkPairTerm(YAP_GetFromSlot(h),YAP_GetFromSlot(tail)); + return YAP_Unify(YAP_GetFromSlot(t), pairterm); } /* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_list_chars(term_t t, const char *chars) { - Term chterm = YapBufferToString((char *)chars); - return unify(YapGetFromSlot(t), chterm); + YAP_Term chterm = YAP_BufferToString((char *)chars); + return YAP_Unify(YAP_GetFromSlot(t), chterm); } /* SWI: int PL_unify_nil(term_t ?l) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_nil(term_t l) { - Term nilterm = MkAtomTerm(YapLookupAtom("[]")); - return unify(YapGetFromSlot(l), nilterm); + YAP_Term nilterm = YAP_MkAtomTerm(YAP_LookupAtom("[]")); + return YAP_Unify(YAP_GetFromSlot(l), nilterm); } /* SWI: int PL_unify_pointer(term_t ?t, void *ptr) @@ -641,16 +641,16 @@ X_API int PL_unify_nil(term_t l) /* SAM TO DO */ X_API int PL_unify_pointer(term_t t, void *ptr) { - Term ptrterm = MkIntTerm((Int)ptr); - return unify(YapGetFromSlot(t), ptrterm); + YAP_Term ptrterm = YAP_MkIntTerm((long int)ptr); + return YAP_Unify(YAP_GetFromSlot(t), ptrterm); } /* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t) - YAP Int unify(Term* a, Term* b) */ + YAP long int unify(YAP_Term* a, Term* b) */ X_API int PL_unify_string_chars(term_t t, const char *chars) { - Term chterm = YapBufferToString((char *)chars); - return unify(YapGetFromSlot(t), chterm); + YAP_Term chterm = YAP_BufferToString((char *)chars); + return YAP_Unify(YAP_GetFromSlot(t), chterm); } typedef struct { @@ -666,66 +666,66 @@ typedef struct { } arg; } arg_types; -static Term +static YAP_Term get_term(arg_types **buf) { arg_types *ptr = *buf; int type = ptr->type; - Term t; + YAP_Term t; switch (type) { /* now build the error string */ case PL_VARIABLE: - t = YapMkVarTerm(); + t = YAP_MkVarTerm(); break; case PL_ATOM: - t = YapMkAtomTerm(ptr->arg.a); + t = YAP_MkAtomTerm(ptr->arg.a); break; case PL_INTEGER: - t = YapMkIntTerm(ptr->arg.l); + t = YAP_MkIntTerm(ptr->arg.l); break; case PL_FLOAT: - t = YapMkFloatTerm(ptr->arg.dbl); + t = YAP_MkFloatTerm(ptr->arg.dbl); break; case PL_POINTER: - t = YapMkIntTerm((Int)(ptr->arg.p)); + t = YAP_MkIntTerm((long int)(ptr->arg.p)); break; case PL_STRING: - t = YapBufferToString(ptr->arg.s); + t = YAP_BufferToString(ptr->arg.s); break; case PL_TERM: - t = YapGetFromSlot(ptr->arg.t); + t = YAP_GetFromSlot(ptr->arg.t); break; case PL_CHARS: - t = MkAtomTerm(YapLookupAtom(ptr->arg.s)); + t = YAP_MkAtomTerm(YAP_LookupAtom(ptr->arg.s)); break; case PL_FUNCTOR: { functor_t f = ptr->arg.f; - Int arity, i; + long int arity, i; term_t loc; - if (IsAtomTerm((Term)f)) { - t = (Term)f; + if (YAP_IsAtomTerm((YAP_Term)f)) { + t = (YAP_Term)f; break; } - arity = YapArityOfFunctor((Functor)f); - loc = YapNewSlots(arity); + arity = YAP_ArityOfFunctor((YAP_Functor)f); + loc = YAP_NewSlots(arity); ptr++; for (i= 0; i < arity; i++) { - YapPutInSlot(loc+i,get_term(&ptr)); + YAP_PutInSlot(loc+i,get_term(&ptr)); } - t = MkApplTerm((Functor)f,arity,YapAddressFromSlot(loc)); + t = YAP_MkApplTerm((YAP_Functor)f,arity,YAP_AddressFromSlot(loc)); } break; case PL_LIST: { term_t loc; - loc = YapNewSlots(2); - YapPutInSlot(loc,get_term(&ptr)); - YapPutInSlot(loc+1,get_term(&ptr)); - t = MkPairTerm(YapGetFromSlot(loc),YapGetFromSlot(loc+1)); + loc = YAP_NewSlots(2); + YAP_PutInSlot(loc,get_term(&ptr)); + YAP_PutInSlot(loc+1,get_term(&ptr)); + t = YAP_MkPairTerm(YAP_GetFromSlot(loc),YAP_GetFromSlot(loc+1)); } break; default: @@ -737,7 +737,7 @@ get_term(arg_types **buf) } /* SWI: int PL_unify_term(term_t ?t1, term_t ?t2) - YAP Int unify(Term* a, Term* b) */ + YAP long int YAP_Unify(YAP_Term* a, Term* b) */ X_API int PL_unify_term(term_t l,...) { va_list ap; @@ -779,8 +779,8 @@ X_API int PL_unify_term(term_t l,...) { functor_t f = va_arg(ap, functor_t); ptr->arg.f = f; - if (!IsAtomTerm((Term)f)) { - nels += YapArityOfFunctor((Functor)f); + if (!YAP_IsAtomTerm((YAP_Term)f)) { + nels += YAP_ArityOfFunctor((YAP_Functor)f); } } break; @@ -795,7 +795,7 @@ X_API int PL_unify_term(term_t l,...) } va_end (ap); ptr = (arg_types *)buffers; - return unify(YapGetFromSlot(l),get_term(&ptr)); + return YAP_Unify(YAP_GetFromSlot(l),get_term(&ptr)); } /* end PL_unify_* functions =============================*/ @@ -809,15 +809,15 @@ X_API void PL_unregister_atom(atom_t atom) X_API int PL_term_type(term_t t) { - /* Yap does not support strings as different objects */ - Term v = YapGetFromSlot(t); - if (IsVarTerm(v)) { + /* YAP_ does not support strings as different objects */ + YAP_Term v = YAP_GetFromSlot(t); + if (YAP_IsVarTerm(v)) { return PL_VARIABLE; - } else if (IsAtomTerm(v)) { + } else if (YAP_IsAtomTerm(v)) { return PL_ATOM; - } else if (IsIntTerm(v)) { + } else if (YAP_IsIntTerm(v)) { return PL_INTEGER; - } else if (IsFloatTerm(v)) { + } else if (YAP_IsFloatTerm(v)) { return PL_FLOAT; } else { return PL_TERM; @@ -826,90 +826,90 @@ X_API int PL_term_type(term_t t) X_API int PL_is_atom(term_t t) { - return IsAtomTerm(YapGetFromSlot(t)); + return YAP_IsAtomTerm(YAP_GetFromSlot(t)); } X_API int PL_is_atomic(term_t ts) { - Term t = YapGetFromSlot(ts); - return !IsVarTerm(t) || !IsApplTerm(t) || !IsPairTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + return !YAP_IsVarTerm(t) || !YAP_IsApplTerm(t) || !YAP_IsPairTerm(t); } X_API int PL_is_compound(term_t ts) { - Term t = YapGetFromSlot(ts); - return (IsApplTerm(t) || IsPairTerm(t)); + YAP_Term t = YAP_GetFromSlot(ts); + return (YAP_IsApplTerm(t) || YAP_IsPairTerm(t)); } X_API int PL_is_functor(term_t ts, functor_t f) { - Term t = YapGetFromSlot(ts); - if (IsApplTerm(t)) { - return FunctorOfTerm(t) == (Functor)f; - } else if (IsPairTerm(t)) { - return FunctorOfTerm(t) == YapMkFunctor(YapLookupAtom("."),2); + YAP_Term t = YAP_GetFromSlot(ts); + if (YAP_IsApplTerm(t)) { + return YAP_FunctorOfTerm(t) == (YAP_Functor)f; + } else if (YAP_IsPairTerm(t)) { + return YAP_FunctorOfTerm(t) == YAP_MkFunctor(YAP_LookupAtom("."),2); } else return 0; } X_API int PL_is_float(term_t ts) { - Term t = YapGetFromSlot(ts); - return IsFloatTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + return YAP_IsFloatTerm(t); } X_API int PL_is_integer(term_t ts) { - Term t = YapGetFromSlot(ts); - return IsIntTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + return YAP_IsIntTerm(t); } X_API int PL_is_list(term_t ts) { - Term t = YapGetFromSlot(ts); - if (IsPairTerm(t)) { + YAP_Term t = YAP_GetFromSlot(ts); + if (YAP_IsPairTerm(t)) { return 1; - } else if (IsAtomTerm(t)) { - return t == MkAtomTerm(YapLookupAtom("[]")); + } else if (YAP_IsAtomTerm(t)) { + return t == YAP_MkAtomTerm(YAP_LookupAtom("[]")); } else return 0; } X_API int PL_is_number(term_t ts) { - Term t = YapGetFromSlot(ts); - return IsIntTerm(t) || IsFloatTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + return YAP_IsIntTerm(t) || YAP_IsFloatTerm(t); } X_API int PL_is_string(term_t ts) { - Term t = YapGetFromSlot(ts); - while (IsPairTerm(t)) { - Term hd = YapHeadOfTerm(t); - Int i; - if (!IsIntTerm(hd)) + YAP_Term t = YAP_GetFromSlot(ts); + while (YAP_IsPairTerm(t)) { + YAP_Term hd = YAP_HeadOfTerm(t); + long int i; + if (!YAP_IsIntTerm(hd)) return 0; - i = IntOfTerm(hd); + i = YAP_IntOfTerm(hd); if (i <= 0 || i >= 255) return 0; - if (!IsIntTerm(hd)) + if (!YAP_IsIntTerm(hd)) return 0; - t = TailOfTerm(t); + t = YAP_TailOfTerm(t); } - if (t != MkAtomTerm(LookupAtom("[]"))) + if (t != YAP_MkAtomTerm(YAP_LookupAtom("[]"))) return 0; return FALSE; } X_API int PL_is_variable(term_t ts) { - Term t = YapGetFromSlot(ts); - return IsVarTerm(t); + YAP_Term t = YAP_GetFromSlot(ts); + return YAP_IsVarTerm(t); } X_API void PL_halt(int e) { - YapHalt(e); + YAP_Halt(e); } X_API fid_t @@ -933,10 +933,10 @@ PL_discard_foreign_frame(fid_t f) X_API term_t PL_exception(qid_t q) { - Term t; - if (YapGoalHasException(&t)) { - term_t to = YapNewSlots(1); - YapPutInSlot(to,t); + YAP_Term t; + if (YAP_GoalHasException(&t)) { + term_t to = YAP_NewSlots(1); + YAP_PutInSlot(to,t); return to; } else { return 0L; @@ -946,7 +946,7 @@ PL_exception(qid_t q) X_API int PL_initialise(int myargc, char **myargv, char **myenviron) { - yap_init_args init_args; + YAP_init_args init_args; init_args.Argv = myargv; init_args.Argc = myargc; @@ -961,16 +961,16 @@ PL_initialise(int myargc, char **myargv, char **myenviron) init_args.NumberWorkers = 1; init_args.SchedulerLoop = 10; init_args.DelayedReleaseLoad = 3; - return YapInit(&init_args); + return YAP_Init(&init_args); } X_API predicate_t PL_pred(functor_t f, module_t m) { - if (IsAtomTerm(f)) { - return YapPredicate(AtomOfTerm(f),0,m); + if (YAP_IsAtomTerm(f)) { + return YAP_Predicate(YAP_AtomOfTerm(f),0,m); } else { - Functor tf = (Functor)f; - return YapPredicate(YapNameOfFunctor(tf),YapArityOfFunctor(tf),m); + YAP_Functor tf = (YAP_Functor)f; + return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),m); } } @@ -978,23 +978,23 @@ X_API predicate_t PL_predicate(const char *name, int arity, const char *m) { int mod; if (m == NULL) - mod = YapCurrentModule(); + mod = YAP_CurrentModule(); else - mod = YapLookupModule(MkAtomTerm(LookupAtom((char *)m))); - return YapPredicate(YapLookupAtom((char *)name), + mod = YAP_LookupModule(YAP_MkAtomTerm(YAP_LookupAtom((char *)m))); + return YAP_Predicate(YAP_LookupAtom((char *)name), arity, mod); } X_API void PL_predicate_info(predicate_t p,atom_t *name, int *arity, module_t *m) { - YapPredicateInfo(p, name, (Int *)arity, (Int *)m); + YAP_PredicateInfo(p, name, (unsigned long int *)arity, (int *)m); } typedef struct open_query_struct { int open; int state; - Term g; + YAP_Term g; } open_query; open_query execution; @@ -1002,25 +1002,25 @@ open_query execution; X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0) { atom_t name; - Int arity; - Int m; - Term t[2]; + unsigned long int arity; + int m; + YAP_Term t[2]; /* ignore flags and module for now */ if (execution.open != 0) { - YapError("only one query at a time allowed\n"); + YAP_Error("only one query at a time allowed\n"); } execution.open=1; execution.state=0; - YapPredicateInfo(p, &name, &arity, &m); - t[0] = YapModuleName(m); + YAP_PredicateInfo(p, &name, &arity, &m); + t[0] = YAP_ModuleName(m); if (arity == 0) { - t[1] = YapMkAtomTerm(name); + t[1] = YAP_MkAtomTerm(name); } else { - Functor f = YapMkFunctor(name, arity); - t[1] = YapMkApplTerm(f,arity,YapAddressFromSlot(t0)); + YAP_Functor f = YAP_MkFunctor(name, arity); + t[1] = YAP_MkApplTerm(f,arity,YAP_AddressFromSlot(t0)); } - execution.g = MkApplTerm(YapMkFunctor(YapLookupAtom(":"),2),2,t); + execution.g = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom(":"),2),2,t); return &execution; } @@ -1030,9 +1030,9 @@ X_API int PL_next_solution(qid_t qi) if (qi->open != 1) return 0; if (qi->state == 0) { - result = YapRunGoal(qi->g); + result = YAP_RunGoal(qi->g); } else { - result = YapRestartGoal(); + result = YAP_RestartGoal(); } qi->state = 1; if (result == 0) { @@ -1043,7 +1043,7 @@ X_API int PL_next_solution(qid_t qi) X_API void PL_cut_query(qid_t qi) { - YapPruneGoal(); + YAP_PruneGoal(); qi->open = 0; } @@ -1052,8 +1052,8 @@ X_API void PL_close_query(qid_t qi) /* need to implement backtracking here */ if (qi->open != 1) return; - YapPruneGoal(); - YapRestartGoal(); + YAP_PruneGoal(); + YAP_RestartGoal(); qi->open = 0; } @@ -1067,18 +1067,18 @@ X_API int PL_call_predicate(module_t ctx, int flags, predicate_t p, term_t t0) X_API int PL_call(term_t tp, module_t m) { - Term t[2], g; - t[0] = YapModuleName(m); - t[1] = YapGetFromSlot(tp); - g = MkApplTerm(YapMkFunctor(YapLookupAtom(":"),2),2,t); - return YapRunGoal(g); + YAP_Term t[2], g; + t[0] = YAP_ModuleName(m); + t[1] = YAP_GetFromSlot(tp); + g = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom(":"),2),2,t); + return YAP_RunGoal(g); } X_API void PL_register_extensions(PL_extension *ptr) { /* ignore flags for now */ while(ptr->predicate_name != NULL) { - YapUserCPredicateWithArgs(ptr->predicate_name,ptr->function,ptr->arity,YapCurrentModule()); + YAP_UserCPredicateWithArgs(ptr->predicate_name,ptr->function,ptr->arity,YAP_CurrentModule()); ptr++; } } diff --git a/library/yap2swi/yap2swi.h b/library/yap2swi/yap2swi.h index 28b6848cd..5c3b62aed 100644 --- a/library/yap2swi/yap2swi.h +++ b/library/yap2swi/yap2swi.h @@ -12,7 +12,7 @@ //=== includes =============================================================== -#include +#include #include #if defined(_MSC_VER) && defined(YAP_EXPORTS) @@ -24,8 +24,8 @@ typedef unsigned int fid_t; typedef unsigned int term_t; typedef int module_t; -typedef Atom atom_t; -typedef Term *predicate_t; +typedef YAP_Atom atom_t; +typedef YAP_Term *predicate_t; typedef struct open_query_struct *qid_t; typedef long functor_t; typedef int (*PL_agc_hook_t)(atom_t); @@ -95,7 +95,7 @@ extern X_API term_t PL_new_term_refs(int); extern X_API void PL_reset_term_refs(term_t); /* begin PL_get_* functions =============================*/ extern X_API int PL_get_arg(int, term_t, term_t); -extern X_API int PL_get_atom(term_t, Atom *); +extern X_API int PL_get_atom(term_t, YAP_Atom *); extern X_API int PL_get_atom_chars(term_t, char **); extern X_API int PL_get_chars(term_t, char **, unsigned); extern X_API int PL_get_functor(term_t, functor_t *); diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index da26e534b..f78da24ff 100644 --- a/m4/Yatom.h.m4 +++ b/m4/Yatom.h.m4 @@ -239,7 +239,7 @@ Inline(IsPredProperty, PropFlags, int, flags, (flags == PEProp) ) /********* maximum number of C-written predicates and cmp funcs ******************/ -#define MAX_C_PREDS 360 +#define MAX_C_PREDS 400 #define MAX_CMP_FUNCS 20 typedef struct { diff --git a/misc/yap.def b/misc/yap.def index 04c2c874f..3c693ec67 100644 --- a/misc/yap.def +++ b/misc/yap.def @@ -1,85 +1,85 @@ EXPORTS -YapA -YapInit -YapRunGoal -YapRestartGoal -YapReset -Deref -YapIsVarTerm -YapIsNonVarTerm -YapMkVarTerm -YapIsIntTerm -YapIsFloatTerm -YapIsDbRefTerm -YapIsAtomTerm -YapIsPairTerm -YapIsApplTerm -YapMkIntTerm -YapIntOfTerm -YapMkFloatTerm -YapFloatOfTerm -YapMkAtomTerm -YapAtomOfTerm -YapLookupAtom -YapFullLookupAtom -YapAtomName -YapMkPairTerm -YapMkNewPairTerm -YapHeadOfTerm -YapTailOfTerm -YapMkApplTerm -YapMkNewApplTerm -YapFunctorOfTerm -YapArgOfTerm -YapMkFunctor -YapNameOfFunctor -YapArityOfFunctor -YapExtraSpace -YapUnify -UserCPredicate -UserBackCPredicate -YapCallProlog -Yapcut_fail -Yapcut_succeed -YapAllocSpaceFromYap -YapFreeSpaceFromYap -YapStringToBuffer -YapBufferToString -YapBufferToAtomList -YapError -YapRunGoal -YapContinueGoal -YapPruneGoal -YapGoalHasException -YapRead -YapCompileClause -YapInit -YapFastInit -YapPutValue -YapGetValue -YapReset -YapExit -YapInitSocks -YapSetOutputMessage -YapWrite -YapInitConsult -YapEndConsult -YapStreamToFileNo -YapCloseAllOpenStreams -YapOpenStream -YapNewSlots -YapInitSlot -YapGetFromSlot -YapAddressFromSlot -YapPutInSlot -YapRecoverSlots -YapThrow -YapLookupModule -YapModuleName -YapHalt -YapTopOfLocalStack -YapPredicate -YapCurrentModule -YapPredicateInfo -YapUserCPredicateWithArgs +YAP_A +YAP_Init +YAP_RunGoal +YAP_RestartGoal +YAP_Reset +YAP_Deref +YAP_IsVarTerm +YAP_IsNonVarTerm +YAP_MkVarTerm +YAP_IsIntTerm +YAP_IsFloatTerm +YAP_IsDbRefTerm +YAP_IsAtomTerm +YAP_IsPairTerm +YAP_IsApplTerm +YAP_MkIntTerm +YAP_IntOfTerm +YAP_MkFloatTerm +YAP_FloatOfTerm +YAP_MkAtomTerm +YAP_AtomOfTerm +YAP_LookupAtom +YAP_FullLookupAtom +YAP_AtomName +YAP_MkPairTerm +YAP_MkNewPairTerm +YAP_HeadOfTerm +YAP_TailOfTerm +YAP_MkApplTerm +YAP_MkNewApplTerm +YAP_FunctorOfTerm +YAP_ArgOfTerm +YAP_MkFunctor +YAP_NameOfFunctor +YAP_ArityOfFunctor +YAP_ExtraSpace +YAP_Unify +YAP_UserCPredicate +YAP_UserCPredicateWithArgs +YAP_UserBackCPredicate +YAP_CallProlog +YAP_cut_fail +YAP_cut_succeed +YAP_AllocSpaceFromYap +YAP_FreeSpaceFromYap +YAP_StringToBuffer +YAP_BufferToString +YAP_BufferToAtomList +YAP_Error +YAP_RunGoal +YAP_ContinueGoal +YAP_PruneGoal +YAP_GoalHasException +YAP_Read +YAP_CompileClause +YAP_Init +YAP_FastInit +YAP_PutValue +YAP_GetValue +YAP_Reset +YAP_Exit +YAP_InitSocks +YAP_SetOutputMessage +YAP_Write +YAP_InitConsult +YAP_EndConsult +YAP_StreamToFileNo +YAP_CloseAllOpenStreams +YAP_OpenStream +YAP_NewSlots +YAP_InitSlot +YAP_GetFromSlot +YAP_AddressFromSlot +YAP_PutInSlot +YAP_RecoverSlots +YAP_Throw +YAP_LookupModule +YAP_ModuleName +YAP_Halt +YAP_TopOfLocalStack +YAP_Predicate +YAP_CurrentModule +YAP_PredicateInfo diff --git a/pl/boot.yap b/pl/boot.yap index 5851cfb66..7d7802c37 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -249,7 +249,7 @@ repeat :- '$repeat'. % Hack in case expand_term has created a list of commands. % '$execute_commands'(V,_,_) :- var(V), !, - throw(error(instantiation_error,meta_call(V))). + '$do_error'(instantiation_error,meta_call(V)). '$execute_commands'([],_,_) :- !, fail. '$execute_commands'([C|_],VL,Con) :- '$execute_command'(C,VL,Con). @@ -263,12 +263,12 @@ repeat :- '$repeat'. % '$execute_command'(C,_,top) :- var(C), !, - throw(error(instantiation_error,meta_call(C))). + '$do_error'(instantiation_error,meta_call(C)). '$execute_command'(end_of_file,_,_). '$execute_command'(C,_,top) :- number(C), !, - throw(error(type_error(callable,C),meta_call(C))). + '$do_error'(type_error(callable,C),meta_call(C)). '$execute_command'(R,_,top) :- db_reference(R), !, - throw(error(type_error(callable,R),meta_call(R))). + '$do_error'(type_error(callable,R),meta_call(R)). '$execute_command'((:-G),_,Option) :- !, '$current_module'(M), '$process_directive'(G, Option, M), @@ -288,7 +288,7 @@ repeat :- '$repeat'. '$access_yap_flags'(8, 0), !, % YAP mode, go in and do it, '$process_directive'(G, consult, M). '$process_directive'(G, top, _) :- !, - throw(error(context_error((:- G),clause),query)). + '$do_error'(context_error((:- G),clause),query). % % always allow directives. % @@ -313,7 +313,7 @@ repeat :- '$repeat'. % '$process_directive'(D, _, M) :- '$access_yap_flags'(8, 1), !, % ISO Prolog mode, go in and do it, - throw(error(context_error((:- M:D),query),directive)). + '$do_error'(context_error((:- M:D),query),directive). % % but YAP and SICStus does. % @@ -706,7 +706,7 @@ not(A) :- \+ '$execute_within'(A). '$call'(M:_,_,G0,_) :- var(M), !, - throw(error(instantiation_error,call(G0))). + '$do_error'(instantiation_error,call(G0)). '$call'(M:G,CP,G0,_) :- !, '$call'(G,CP,G0,M). '$call'((X,Y),CP,G0,M) :- !, @@ -819,13 +819,13 @@ not(A) :- '$check_callable'(V,G) :- var(V), !, '$current_module'(Mod), - throw(error(instantiation_error,Mod:G)). + '$do_error'(instantiation_error,Mod:G). '$check_callable'(A,G) :- number(A), !, '$current_module'(Mod), - throw(error(type_error(callable,A),Mod:G)). + '$do_error'(type_error(callable,A),Mod:G). '$check_callable'(R,G) :- db_reference(R), !, '$current_module'(Mod), - throw(error(type_error(callable,R),Mod:G)). + '$do_error'(type_error(callable,R),Mod:G). '$check_callable'(_,_). % Called by the abstract machine, if no clauses exist for a predicate @@ -876,13 +876,13 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$csult'(V, _) :- var(V), !, - throw(error(instantiation_error,consult(V))). + '$do_error'(instantiation_error,consult(V)). '$csult'([], _) :- !. '$csult'([-F|L], M) :- !, '$reconsult'(M:F), '$csult'(L, M). '$csult'([F|L], M) :- '$consult'(M:F), '$csult'(L, M). '$consult'(V) :- var(V), !, - throw(error(instantiation_error,consult(V))). + '$do_error'(instantiation_error,consult(V)). '$consult'([]) :- !. '$consult'([F|Fs]) :- !, '$consult'(F), @@ -898,7 +898,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$consult'(X,Stream), '$close'(Stream). '$consult'(X) :- - throw(error(permission_error(input,stream,X),consult(X))). + '$do_error'(permission_error(input,stream,X),consult(X)). '$consult'(_,Stream) :- @@ -1002,7 +1002,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$command'(Command,Vars,Status). '$abort_loop'(Stream) :- - throw(error(permission_error(input,closed_stream,Stream), loop)). + '$do_error'(permission_error(input,closed_stream,Stream), loop). /* General purpose predicates */ @@ -1018,11 +1018,11 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$check_head'(H,P). '$check_head'(H,P) :- var(H), !, - throw(error(instantiation_error,P)). + '$do_error'(instantiation_error,P). '$check_head'(H,P) :- number(H), !, - throw(error(type_error(callable,H),P)). + '$do_error'(type_error(callable,H),P). '$check_head'(H,P) :- db_reference(H), !, - throw(error(type_error(callable,H),P)). + '$do_error'(type_error(callable,H),P). '$check_head'(_,_). % Path predicates @@ -1044,7 +1044,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$find_in_path'(File,NewFile,_) :- atom(File), !, '$search_in_path'(File,NewFile),!. '$find_in_path'(File,_,Call) :- - throw(error(domain_error(source_sink,File),Call)). + '$do_error'(domain_error(source_sink,File),Call). '$search_in_path'(New,New) :- '$exists'(New,'$csult'), !. diff --git a/pl/callcount.yap b/pl/callcount.yap index d945abc49..691e73291 100644 --- a/pl/callcount.yap +++ b/pl/callcount.yap @@ -30,7 +30,7 @@ call_count(Calls, Retries, Both) :- '$check_if_call_count_on'(Calls, 1) :- integer(Calls), !. '$check_if_call_count_on'(Calls, 0) :- var(Calls), !. '$check_if_call_count_on'(Calls, _) :- - throw(error(type_error(integer,Calls),call_count(A))). + '$do_error'(type_error(integer,Calls),call_count(A)). diff --git a/pl/checker.yap b/pl/checker.yap index 5644de2c1..7a0f75542 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -187,7 +187,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). nl(user_error). '$multifile'(V, _) :- var(V), !, - throw(error(instantiation_error,multifile(V))). + '$do_error'(instantiation_error,multifile(V)). '$multifile'((X,Y), M) :- '$multifile'(X, M), '$multifile'(Y, M). '$multifile'(Mod:PredSpec, _) :- !, '$multifile'(PredSpec, Mod). @@ -201,10 +201,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). '$multifile'(N/A, M) :- !, '$new_multifile'(N,A,M). '$multifile'(P, M) :- - throw(error(type_error(predicate_indicator,P),multifile(M:P))). + '$do_error'(type_error(predicate_indicator,P),multifile(M:P)). '$discontiguous'(V,M) :- var(V), !, - throw(error(instantiation_error,M:discontiguous(V))). + '$do_error'(instantiation_error,M:discontiguous(V)). '$discontiguous'((X,Y),M) :- !, '$discontiguous'(X,M), '$discontiguous'(Y,M). @@ -217,7 +217,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). true ). '$discontiguous'(P,M) :- - throw(error(type_error(predicate_indicator,P),M:discontiguous(P))). + '$do_error'(type_error(predicate_indicator,P),M:discontiguous(P)). % % did we declare multifile properly? diff --git a/pl/consult.yap b/pl/consult.yap index 33de5d72b..7b884ec7d 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -19,7 +19,7 @@ ensure_loaded(V) :- '$ensure_loaded'(V). '$ensure_loaded'(V) :- var(V), !, - throw(error(instantiation_error,ensure_loaded(V))). + '$do_error'(instantiation_error,ensure_loaded(V)). '$ensure_loaded'([]) :- !. '$ensure_loaded'([F|Fs]) :- !, '$ensure_loaded'(F), @@ -43,12 +43,12 @@ ensure_loaded(V) :- ), '$close'(Stream). '$ensure_loaded'(X) :- - throw(error(permission_error(input,stream,X),ensure_loaded(X))). + '$do_error'(permission_error(input,stream,X),ensure_loaded(X)). compile(P) :- '$has_yap_or', - throw(error(context_error(compile(P),clause),query)). + '$do_error'(context_error(compile(P),clause),query). compile(P) :- '$compile'(P). @@ -60,18 +60,18 @@ compile(P) :- consult(Fs) :- '$has_yap_or', - throw(error(context_error(consult(Fs),clause),query)). + '$do_error'(context_error(consult(Fs),clause),query). consult(Fs) :- '$consult'(Fs). reconsult(Fs) :- '$has_yap_or', fail, - throw(error(context_error(reconsult(Fs),clause),query)). + '$do_error'(context_error(reconsult(Fs),clause),query). reconsult(Fs) :- '$reconsult'(Fs). '$reconsult'(V) :- var(V), !, - throw(error(instantiation_error,reconsult(V))). + '$do_error'(instantiation_error,reconsult(V)). '$reconsult'([]) :- !. '$reconsult'(M:X) :- atom(M), !, '$current_module'(M0), @@ -87,7 +87,7 @@ reconsult(Fs) :- '$reconsult'(X,Stream), '$close'(Stream). '$reconsult'(X) :- - throw(error(permission_error(input,stream,X),reconsult(X))). + '$do_error'(permission_error(input,stream,X),reconsult(X)). '$reconsult'(F,Stream) :- '$record_loaded'(Stream), @@ -154,11 +154,11 @@ reconsult(Fs) :- '$initialization'(V) :- var(V), !, - throw(error(instantiation_error,initialization(V))). + '$do_error'(instantiation_error,initialization(V)). '$initialization'(C) :- number(C), !, - throw(error(type_error(callable,C),initialization(C))). + '$do_error'(type_error(callable,C),initialization(C)). '$initialization'(C) :- db_reference(C), !, - throw(error(type_error(callable,C),initialization(C))). + '$do_error'(type_error(callable,C),initialization(C)). '$initialization'(G) :- '$recorda'('$initialisation',G,_), fail. @@ -166,7 +166,7 @@ reconsult(Fs) :- '$include'(V, _) :- var(V), !, - throw(error(instantiation_error,include(V))). + '$do_error'(instantiation_error,include(V)). '$include'([], _) :- !. '$include'([F|Fs], Status) :- !, '$include'(F, Status), @@ -177,7 +177,7 @@ reconsult(Fs) :- ( '$open'(Y,'$csult',Stream,0), !, '$loop'(Stream,Status), '$close'(Stream) ; - throw(error(permission_error(input,stream,Y),include(X))) + '$do_error'(permission_error(input,stream,Y),include(X)) ), '$set_value'('$included_file',OY). diff --git a/pl/debug.yap b/pl/debug.yap index 0fb074c7a..86f96df89 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -30,7 +30,7 @@ % $suspy does most of the work '$suspy'(V,S,M) :- var(V) , !, - throw(error(instantiation_error,M:spy(V,S))). + '$do_error'(instantiation_error,M:spy(V,S)). '$suspy'((M:S),P,_) :- !, '$suspy'(S,P,M). '$suspy'([],_,_) :- !. @@ -41,9 +41,9 @@ '$suspy'(A,S,M) :- atom(A), !, '$suspy_predicates_by_name'(A,S,M). '$suspy'(P,spy,M) :- !, - throw(error(domain_error(predicate_spec,P),spy(M:P))). + '$do_error'(domain_error(predicate_spec,P),spy(M:P)). '$suspy'(P,nospy,M) :- - throw(error(domain_error(predicate_spec,P),nospy(M:P))). + '$do_error'(domain_error(predicate_spec,P),nospy(M:P)). '$suspy_predicates_by_name'(A,S,M) :- % just check one such predicate exists @@ -85,9 +85,9 @@ '$do_suspy'(S, F, N, T, M) :- '$system_predicate'(T,M), ( S = spy -> - throw(error(permission_error(access,private_procedure,T),spy(M:F/N))) + '$do_error'(permission_error(access,private_procedure,T),spy(M:F/N)) ; - throw(error(permission_error(access,private_procedure,T),nospy(M:F/N))) + '$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N)) ). '$do_suspy'(S,F,N,T,M) :- '$suspy2'(S,F,N,T,M). @@ -162,13 +162,13 @@ notrace :- leash(X) :- var(X), - throw(error(instantiation_error,leash(X))). + '$do_error'(instantiation_error,leash(X)). leash(X) :- '$leashcode'(X,Code), '$set_value'('$leash',Code), '$show_leash'(informational,Code), !. leash(X) :- - throw(error(type_error(leash_mode,X),leash(X))). + '$do_error'(type_error(leash_mode,X),leash(X)). '$show_leash'(Msg,0) :- '$print_message'(Msg,leash([])). @@ -194,10 +194,10 @@ leash(X) :- '$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111. '$list2Code'(V,_) :- var(V), !, - throw(error(instantiation_error,leash(V))). + '$do_error'(instantiation_error,leash(V)). '$list2Code'([],0) :- !. '$list2Code'([V|L],_) :- var(V), !, - throw(error(instantiation_error,leash([V|L]))). + '$do_error'(instantiation_error,leash([V|L])). '$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 2'1000 + N1. '$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 2'0100 + N1. '$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1. @@ -632,11 +632,11 @@ debugging :- %'$creep_call'(G,_) :- write(user_error,'$creepcall'(G)), nl(user_error), fail. '$creep_call'(V,M,_) :- var(V), !, - throw(error(instantiation_error,meta_call(M:V))). + '$do_error'(instantiation_error,meta_call(M:V)). '$creep_call'(A,M,_) :- number(A), !, - throw(error(type_error(callable,A),meta_call(M:A))). + '$do_error'(type_error(callable,A),meta_call(M:A)). '$creep_call'(R,M,_) :- db_reference(R), !, - throw(error(type_error(callable,R),meta_call(M:R))). + '$do_error'(type_error(callable,R),meta_call(M:R)). '$creep_call'(M:G,_,CP) :- !, '$creep_call'(G,M,CP). '$creep_call'(fail,Module,_) :- !, @@ -744,7 +744,7 @@ debugging :- G=[M|Goal], '$execute'(M:Goal). '$creep'([M|V]) :- var(V), !, - throw(error(instantiation_error,M:call(M:V))). + '$do_error'(instantiation_error,M:call(M:V)). '$creep'([M|'$execute_in_mod'(G,ModNum)]) :- !, '$module_number'(Mod,ModNum), '$creep'([Mod|G]). diff --git a/pl/directives.yap b/pl/directives.yap index e3a44f17e..631603d20 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -190,9 +190,9 @@ yap_flag(bounded,X) :- '$transl_to_true_false'(X1,X). yap_flag(bounded,X) :- !, (X = true ; X = false), !, - throw(error(permission_error(modify,flag,bounded),yap_flag(bounded,X))). + '$do_error'(permission_error(modify,flag,bounded),yap_flag(bounded,X)). yap_flag(bounded,X) :- - throw(error(domain_error(flag_value,bounded+X),yap_flag(bounded,X))). + '$do_error'(domain_error(flag_value,bounded+X),yap_flag(bounded,X)). % do or do not indexation yap_flag(index,X) :- var(X), !, @@ -205,7 +205,7 @@ yap_flag(informational_messages,X) :- var(X), !, yap_flag(informational_messages,on) :- !, '$set_value'('$verbose',on). yap_flag(informational_messages,off) :- !, '$set_value'('$verbose',off). yap_flag(informational_messages,X) :- - throw(error(domain_error(flag_value,informational_messages+X),yap_flag(informational_messages,X))). + '$do_error'(domain_error(flag_value,informational_messages+X),yap_flag(informational_messages,X)). yap_flag(integer_rounding_function,X) :- var(X), !, @@ -213,9 +213,9 @@ yap_flag(integer_rounding_function,X) :- '$transl_to_rounding_function'(X1,X). yap_flag(integer_rounding_function,X) :- (X = down; X = toward_zero), !, - throw(error(permission_error(modify,flag,integer_rounding_function),yap_flag(integer_rounding_function,X))). + '$do_error'(permission_error(modify,flag,integer_rounding_function),yap_flag(integer_rounding_function,X)). yap_flag(integer_rounding_function,X) :- - throw(error(domain_error(flag_value,integer_rounding_function+X),yap_flag(integer_rounding_function,X))). + '$do_error'(domain_error(flag_value,integer_rounding_function+X),yap_flag(integer_rounding_function,X)). yap_flag(max_arity,X) :- var(X), !, @@ -223,15 +223,15 @@ yap_flag(max_arity,X) :- '$transl_to_arity'(X1,X). yap_flag(max_arity,X) :- integer(X), X > 0, !, - throw(error(permission_error(modify,flag,max_arity),yap_flag(max_arity,X))). + '$do_error'(permission_error(modify,flag,max_arity),yap_flag(max_arity,X)). yap_flag(max_arity,X) :- - throw(error(domain_error(flag_value,max_arity+X),yap_flag(max_arity,X))). + '$do_error'(domain_error(flag_value,max_arity+X),yap_flag(max_arity,X)). yap_flag(version,X) :- var(X), !, '$get_value'('$version_name',X). yap_flag(version,X) :- - throw(error(permission_error(modify,flag,version),yap_flag(version,X))). + '$do_error'(permission_error(modify,flag,version),yap_flag(version,X)). yap_flag(max_integer,X) :- var(X), !, @@ -239,9 +239,9 @@ yap_flag(max_integer,X) :- '$access_yap_flags'(3, X). yap_flag(max_integer,X) :- integer(X), X > 0, !, - throw(error(permission_error(modify,flag,max_integer),yap_flag(max_integer,X))). + '$do_error'(permission_error(modify,flag,max_integer),yap_flag(max_integer,X)). yap_flag(max_integer,X) :- - throw(error(domain_error(flag_value,max_integer+X),yap_flag(max_integer,X))). + '$do_error'(domain_error(flag_value,max_integer+X),yap_flag(max_integer,X)). yap_flag(min_integer,X) :- var(X), !, @@ -249,9 +249,9 @@ yap_flag(min_integer,X) :- '$access_yap_flags'(4, X). yap_flag(min_integer,X) :- integer(X), X < 0, !, - throw(error(permission_error(modify,flag,min_integer),yap_flag(min_integer,X))). + '$do_error'(permission_error(modify,flag,min_integer),yap_flag(min_integer,X)). yap_flag(min_integer,X) :- - throw(error(domain_error(flag_value,min_integer+X),yap_flag(min_integer,X))). + '$do_error'(domain_error(flag_value,min_integer+X),yap_flag(min_integer,X)). yap_flag(char_conversion,X) :- var(X), !, @@ -266,7 +266,7 @@ yap_flag(char_conversion,X) :- '$disable_char_conversion' ). yap_flag(char_conversion,X) :- - throw(error(domain_error(flag_value,char_conversion+X),yap_flag(char_conversion,X))). + '$do_error'(domain_error(flag_value,char_conversion+X),yap_flag(char_conversion,X)). yap_flag(double_quotes,X) :- var(X), !, @@ -276,7 +276,7 @@ yap_flag(double_quotes,X) :- '$transl_to_trl_types'(X1,X), !, '$set_yap_flags'(6,X1). yap_flag(double_quotes,X) :- - throw(error(domain_error(flag_value,double_quotes+X),yap_flag(double_quotes,X))). + '$do_error'(domain_error(flag_value,double_quotes+X),yap_flag(double_quotes,X)). yap_flag(n_of_integer_keys_in_db,X) :- var(X), !, @@ -284,7 +284,7 @@ yap_flag(n_of_integer_keys_in_db,X) :- yap_flag(n_of_integer_keys_in_db,X) :- integer(X), X > 0, !, '$resize_int_keys'(X). yap_flag(n_of_integer_keys_in_db,X) :- - throw(error(domain_error(flag_value,n_of_integer_keys_in_db+X),yap_flag(n_of_integer_keys_in_db,X))). + '$do_error'(domain_error(flag_value,n_of_integer_keys_in_db+X),yap_flag(n_of_integer_keys_in_db,X)). yap_flag(n_of_integer_keys_in_bb,X) :- var(X), !, @@ -292,7 +292,7 @@ yap_flag(n_of_integer_keys_in_bb,X) :- yap_flag(n_of_integer_keys_in_bb,X) :- integer(X), X > 0, !, '$resize_bb_int_keys'(X). yap_flag(n_of_integer_keys_in_bb,X) :- - throw(error(domain_error(flag_value,n_of_integer_keys_in_bb+X),yap_flag(n_of_integer_keys_in_bb,X))). + '$do_error'(domain_error(flag_value,n_of_integer_keys_in_bb+X),yap_flag(n_of_integer_keys_in_bb,X)). yap_flag(strict_iso,OUT) :- var(OUT), !, @@ -306,7 +306,7 @@ yap_flag(strict_iso,off) :- !, '$transl_to_on_off'(X,off), '$set_yap_flags'(9,X). yap_flag(strict_iso,X) :- - throw(error(domain_error(flag_value,strict_iso+X),yap_flag(strict_iso,X))). + '$do_error'(domain_error(flag_value,strict_iso+X),yap_flag(strict_iso,X)). yap_flag(language,X) :- var(X), !, @@ -317,7 +317,7 @@ yap_flag(language,X) :- '$set_yap_flags'(8,N), '$adjust_language'(X). yap_flag(language,X) :- - throw(error(domain_error(flag_value,language+X),yap_flag(language,X))). + '$do_error'(domain_error(flag_value,language+X),yap_flag(language,X)). yap_flag(debug,X) :- var(X), !, @@ -330,7 +330,7 @@ yap_flag(debug,X) :- '$transl_to_on_off'(_,X), !, (X = on -> debug ; nodebug). yap_flag(debug,X) :- - throw(error(domain_error(flag_value,debug+X),yap_flag(debug,X))). + '$do_error'(domain_error(flag_value,debug+X),yap_flag(debug,X)). yap_flag(discontiguous_warnings,X) :- var(X), !, @@ -347,7 +347,7 @@ yap_flag(discontiguous_warnings,X) :- ; '$syntax_check_discontiguous'(_,off)). yap_flag(discontiguous_warnings,X) :- - throw(error(domain_error(flag_value,discontiguous_warnings+X),yap_flag(discontiguous_warnings,X))). + '$do_error'(domain_error(flag_value,discontiguous_warnings+X),yap_flag(discontiguous_warnings,X)). yap_flag(redefine_warnings,X) :- var(X), !, @@ -364,7 +364,7 @@ yap_flag(redefine_warnings,X) :- ; '$syntax_check_multiple'(_,off)). yap_flag(redefine_warnings,X) :- - throw(error(domain_error(flag_value,redefine_warnings+X),yap_flag(redefine_warnings,X))). + '$do_error'(domain_error(flag_value,redefine_warnings+X),yap_flag(redefine_warnings,X)). yap_flag(single_var_warnings,X) :- var(X), !, @@ -381,7 +381,7 @@ yap_flag(single_var_warnings,X) :- ; '$syntax_check_single_var'(_,off)). yap_flag(single_var_warnings,X) :- - throw(error(domain_error(flag_value,single_var_warnings+X),yap_flag(single_var_warnings,X))). + '$do_error'(domain_error(flag_value,single_var_warnings+X),yap_flag(single_var_warnings,X)). yap_flag(unknown,X) :- var(X), !, @@ -397,7 +397,7 @@ yap_flag(to_chars_mode,quintus) :- !, yap_flag(to_chars_mode,iso) :- !, '$set_yap_flags'(7,1). yap_flag(to_chars_mode,X) :- - throw(error(domain_error(flag_value,to_chars_mode+X),yap_flag(to_chars_mode,X))). + '$do_error'(domain_error(flag_value,to_chars_mode+X),yap_flag(to_chars_mode,X)). yap_flag(character_escapes,X) :- var(X), !, @@ -407,7 +407,7 @@ yap_flag(character_escapes,X) :- !, '$transl_to_character_escape_modes'(Y,X), !, '$set_yap_flags'(12,Y). yap_flag(character_escapes,X) :- - throw(error(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X))). + '$do_error'(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X)). yap_flag(update_semantics,X) :- var(X), !, @@ -419,7 +419,7 @@ yap_flag(update_semantics,logical_assert) :- !, yap_flag(update_semantics,immediate) :- !, '$switch_log_upd'(0). yap_flag(update_semantics,X) :- - throw(error(domain_error(flag_value,update_semantics+X),yap_flag(update_semantics,X))). + '$do_error'(domain_error(flag_value,update_semantics+X),yap_flag(update_semantics,X)). yap_flag(toplevel_hook,X) :- var(X), !, @@ -444,7 +444,7 @@ yap_flag(write_strings,off) :- !, '$transl_to_on_off'(X,off), '$set_yap_flags'(13,X). yap_flag(write_strings,X) :- - throw(error(domain_error(flag_value,write_strings+X),yap_flag(write_strings,X))). + '$do_error'(domain_error(flag_value,write_strings+X),yap_flag(write_strings,X)). yap_flag(user_input,OUT) :- var(OUT), !, @@ -492,7 +492,7 @@ yap_flag(fileerrors,on) :- !, yap_flag(fileerrors,off) :- !, '$set_value'(fileerrors,0). yap_flag(fileerrors,X) :- - throw(error(domain_error(flag_value,fileerrors+X),yap_flag(fileerrors,X))). + '$do_error'(domain_error(flag_value,fileerrors+X),yap_flag(fileerrors,X)). :- '$recorda'('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_). @@ -631,23 +631,23 @@ current_prolog_flag(V,Out) :- yap_flag(V,NOut), NOut = Out. current_prolog_flag(V,Out) :- - throw(error(type_error(atom,V),current_prolog_flag(V,Out))). + '$do_error'(type_error(atom,V),current_prolog_flag(V,Out)). set_prolog_flag(F,V) :- var(F), !, - throw(error(instantiation_error,set_prolog_flag(F,V))). + '$do_error'(instantiation_error,set_prolog_flag(F,V)). set_prolog_flag(F,V) :- var(V), !, - throw(error(instantiation_error,set_prolog_flag(F,V))). + '$do_error'(instantiation_error,set_prolog_flag(F,V)). set_prolog_flag(F,V) :- \+ atom(F), !, - throw(error(type_error(atom,F),set_prolog_flag(F,V))). + '$do_error'(type_error(atom,F),set_prolog_flag(F,V)). set_prolog_flag(F,V) :- yap_flag(F,V). prolog_flag(F, Old, New) :- var(F), !, - throw(error(instantiation_error,prolog_flag(F,Old,New))). + '$do_error'(instantiation_error,prolog_flag(F,Old,New)). prolog_flag(F, Old, New) :- current_prolog_flag(F, Old), set_prolog_flag(F, New). diff --git a/pl/errors.yap b/pl/errors.yap index 953c48493..0004ab5fe 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -15,6 +15,10 @@ * * *************************************************************************/ +'$do_error'(Type,Message) :- + '$current_stack'(local_sp(_,Envs,CPs)), + throw(error(Type,[Message|local_sp(Message,Envs,CPs)])). + '$Error'(E) :- '$LoopError'(E). @@ -47,8 +51,13 @@ print_message(Level, Mss) :- '$print_message'(Severity, Msg) :- \+ '$undefined'(portray_message(Severity, Msg), user), user:portray_message(Severity, Msg), !. -'$print_message'(error,error(Msg,Where)) :- - '$output_error_message'(Msg, Where), !. +'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !, + '$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR'). +'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :- + '$show_cps'(CPs), + '$show_envs'(Envs), + '$prepare_loc'(Info,Where,Location), + '$output_error_message'(Msg, Location), !. '$print_message'(error,Throw) :- '$format'(user_error,"[ No handler for error ~w ]~n", [Throw]). '$print_message'(informational,M) :- @@ -127,6 +136,50 @@ print_message(Level, Mss) :- '$format'(user_error,"~n ~w",[P]), '$print_list_of_preds'(L). +'$show_cps'(List) :- + '$format'(user_error,"[ Goals with alternatives open:~n",[]), + '$print_stack'(List), + '$format'(user_error," ]~n",[]). + +'$show_envs'(List) :- + '$format'(user_error,"[ Goals left to continue:~n",[]), + '$print_stack'(List), + '$format'(user_error," ]~n",[]). + +'$prepare_loc'(Info,Where,Location) :- integer(Where), !, + '$pred_for_code'(Where,Name,Arity,Mod,Clause), + '$construct_code'(Clause,Name,Arity,Mod,Info,Location). +'$prepare_loc'(Info,Where,Info). + +'$print_stack'([]). +'$print_stack'([G|List]) :- + '$pred_for_code'(G,Name,Arity,Mod,Clause), + ( + Name = '$yes_no' ; Name = '$query' ; Name = '$do_yes_no' -> + true + ; + '$show_goal'(Clause,Name,Arity,Mod), + '$print_stack'(List) + ). + +'$show_goal'(-1,Name,Arity,Mod) :- !, + '$format'(" ~a:~a/~d at indexing code~n",[Mod,Name,Arity]). +'$show_goal'(0,Name,Arity,Mod) :- !. +'$show_goal'(I,Name,Arity,Mod) :- + '$format'(" ~a:~a/~d at clause ~d~n",[Mod,Name,Arity,I]). + +'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !, + number_codes(Arity,ArityCode), + atom_codes(ArityAtom,ArityCode), + atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location). +'$construct_code'(0,_,_,_,Location,Location) :- !. +'$construct_code'(Cl,Name,Arity,Mod,Where,Location) :- + number_codes(Arity,ArityCode), + atom_codes(ArityAtom,ArityCode), + number_codes(Cl,ClCode), + atom_codes(ClAtom,ClCode), + atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location). + '$output_error_message'(context_error(Goal,Who),Where) :- '$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n", [Goal,Who,Where]). diff --git a/pl/grammar.yap b/pl/grammar.yap index bb2b580fd..80afc6306 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -108,10 +108,10 @@ phrase(PhraseDef, WordList) :- phrase(P, S0, S) :- var(P), !, - throw(error(instantiation_error,phrase(P,S0,S))). + '$do_error'(instantiation_error,phrase(P,S0,S)). phrase(P, S0, S) :- ( primitive(P), \+ atom(P) ), !, - throw(error(type_error(callable,P),phrase(P,S0,S))). + '$do_error'(type_error(callable,P),phrase(P,S0,S)). phrase([], S0, S) :- !, S0 = S. phrase([H|T], S0, S) :- !, diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index b0b060279..5b54a38d6 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -22,43 +22,43 @@ load_foreign_files(Objs,Libs,Entry) :- '$load_foreign_files'(NewObjs,Libs,Entry). '$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_objs_for_load_foreign_files'([],[],_) :- !. '$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !, '$check_obj_for_load_foreign_files'(Obj,NObj,G), '$check_objs_for_load_foreign_files'(Objs,NewObjs,G). '$check_objs_for_load_foreign_files'(Objs,_,G) :- - throw(error(type_error(list,Objs),G)). + '$do_error'(type_error(list,Objs),G). '$check_obj_for_load_foreign_files'(V,_,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_obj_for_load_foreign_files'(Obj,NewObj,_) :- atom(Obj), !, atom_codes(Obj,ObjCodes), '$process_obj_suffix'(ObjCodes,NewObjCodes), atom_codes(NewObj,NewObjCodes). '$check_obj_for_load_foreign_files'(Obj,_,G) :- - throw(error(type_error(atom,Obj),G)). + '$do_error'(type_error(atom,Obj),G). '$check_libs_for_load_foreign_files'(V,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_libs_for_load_foreign_files'([],_) :- !. '$check_libs_for_load_foreign_files'([Lib|Libs],G) :- !, '$check_lib_for_load_foreign_files'(Lib,G), '$check_libs_for_load_foreign_files'(Libs,G). '$check_libs_for_load_foreign_files'(Libs,G) :- - throw(error(type_error(list,Libs),G)). + '$do_error'(type_error(list,Libs),G). '$check_lib_for_load_foreign_files'(V,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_lib_for_load_foreign_files'(Lib,_) :- atom(Lib), !. '$check_lib_for_load_foreign_files'(Lib,G) :- - throw(error(type_error(atom,Lib),G)). + '$do_error'(type_error(atom,Lib),G). '$check_entry_for_load_foreign_files'(V,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_entry_for_load_foreign_files'(Entry,_) :- atom(Entry), !. '$check_entry_for_load_foreign_files'(Entry,G) :- - throw(error(type_error(atom,Entry),G)). + '$do_error'(type_error(atom,Entry),G). '$process_obj_suffix'(ObjCodes,ObjCodes) :- diff --git a/pl/modules.yap b/pl/modules.yap index eae321d9a..75687a253 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -23,7 +23,7 @@ use_module(M) :- '$use_module'(M). '$use_module'(V) :- var(V), !, - throw(error(instantiation_error,use_module(V))). + '$do_error'(instantiation_error,use_module(V)). '$use_module'([]) :- !. '$use_module'([A|B]) :- !, '$use_module'(A), @@ -41,16 +41,16 @@ use_module(M) :- '$ensure_loaded'(File) ). '$use_module'(File) :- - throw(error(permission_error(input,stream,File),use_module(File))). + '$do_error'(permission_error(input,stream,File),use_module(File)). use_module(M,I) :- '$use_module'(M, I). '$use_module'(File,Imports) :- var(File), !, - throw(error(instantiation_error,use_module(File,Imports))). + '$do_error'(instantiation_error,use_module(File,Imports)). '$use_module'(File,Imports) :- var(Imports), !, - throw(error(instantiation_error,use_module(File,Imports))). + '$do_error'(instantiation_error,use_module(File,Imports)). '$use_module'(M:F, Imports) :- atom(M), !, '$current_module'(M0), '$change_module'(M), @@ -76,7 +76,7 @@ use_module(M,I) :- fail ). '$use_module'(File,Imports) :- - throw(error(permission_error(input,stream,File),use_module(File,Imports))). + '$do_error'(permission_error(input,stream,File),use_module(File,Imports)). use_module(Mod,F,I) :- '$use_module'(Mod,F,I). @@ -113,7 +113,7 @@ use_module(Mod,F,I) :- fail ). '$use_module'(Module,File,Imports) :- - throw(error(permission_error(input,stream,File),use_module(Module,File,Imports))). + '$do_error'(permission_error(input,stream,File),use_module(Module,File,Imports)). '$consulting_file_name'(Stream,F) :- '$file_name'(Stream, F). @@ -139,17 +139,17 @@ use_module(Mod,F,I) :- '$process_module_decls_options'(Var,Mod) :- var(Var), - throw(error(instantiation_error,Mod)). + '$do_error'(instantiation_error,Mod). '$process_module_decls_options'([],_). '$process_module_decls_options'([H|L],M) :- '$process_module_decls_option'(H,M), '$process_module_decls_options'(L,M). '$process_module_decls_options'(T,M) :- - throw(error(type_error(list,T),M)). + '$do_error'(type_error(list,T),M). '$process_module_decls_option'(Var,M) :- var(Var), - throw(error(instantiation_error,M)). + '$do_error'(instantiation_error,M). '$process_module_decls_option'(At,_) :- atom(At), '$use_module'(At). @@ -158,7 +158,7 @@ use_module(Mod,F,I) :- '$process_module_decls_option'(hidden(Bool),M) :- '$process_hidden_module'(Bool, M). '$process_module_decls_option'(Opt,M) :- - throw(error(domain_error(module_decl_options,Opt),M)). + '$do_error'(domain_error(module_decl_options,Opt),M). '$process_hidden_module'(TNew,M) :- '$convert_true_off_mod3'(TNew, New, M), @@ -168,7 +168,7 @@ use_module(Mod,F,I) :- '$convert_true_off_mod3'(true, off, _). '$convert_true_off_mod3'(false, on, _). '$convert_true_off_mod3'(X, _, M) :- - throw(error(domain_error(module_decl_options,hidden(X)),M)). + '$do_error'(domain_error(module_decl_options,hidden(X)),M). '$prepare_restore_hidden'(Old,Old) :- !. '$prepare_restore_hidden'(Old,New) :- @@ -176,7 +176,7 @@ use_module(Mod,F,I) :- module(N) :- var(N), - throw(error(instantiation_error,module(N))). + '$do_error'(instantiation_error,module(N)). module(N) :- atom(N), !, '$current_module'(_,N), @@ -187,7 +187,7 @@ module(N) :- recorda('$module','$module'(F,N,[]),_) ). module(N) :- - throw(error(type_error(atom,N),module(N))). + '$do_error'(type_error(atom,N),module(N)). '$module_dec'(N,P) :- '$current_module'(Old,N), diff --git a/pl/preds.yap b/pl/preds.yap index 7e4cdbf55..cd05ded6c 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -19,29 +19,29 @@ % to dynamic code asserta(V) :- var(V), !, - throw(error(instantiation_error,asserta(V))). + '$do_error'(instantiation_error,asserta(V)). asserta(C) :- '$current_module'(Mod), '$assert'(C,Mod,first,_,asserta(C)). assertz(V) :- var(V), !, - throw(error(instantiation_error,assertz(V))). + '$do_error'(instantiation_error,assertz(V)). assertz(C) :- '$current_module'(Mod), '$assert'(C,Mod,last,_,assertz(C)). assert(V) :- var(V), !, - throw(error(instantiation_error,assert(V))). + '$do_error'(instantiation_error,assert(V)). assert(C) :- '$current_module'(Mod), '$assert'(C,Mod,last,_,assert(C)). '$assert'(V,Mod,_,_,_) :- var(V), !, - throw(error(instantiation_error,assert(Mod:V))). + '$do_error'(instantiation_error,assert(Mod:V)). '$assert'(M:C,_,Where,R,P) :- !, '$assert'(C,M,Where,R,P). '$assert'((H:-G),M1,Where,R,P) :- - (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !, + (var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !, ( M1 = M -> '$assert'((C:-G),M1,Where,R,P) ; @@ -63,16 +63,16 @@ assert(C) :- '$assert1'(Where,C,C0,Mod,H) ; functor(H, Na, Ar), - throw(error(permission_error(modify,static_procedure,Na/Ar),P)) + '$do_error'(permission_error(modify,static_procedure,Na/Ar),P) ). '$assert_dynamic'(V,Mod,_,_,_) :- var(V), !, - throw(error(instantiation_error,assert(Mod:V))). + '$do_error'(instantiation_error,assert(Mod:V)). '$assert_dynamic'(M:C,_,Where,R,P) :- !, '$assert_dynamic'(C,M,Where,R,P). '$assert_dynamic'((H:-G),M1,Where,R,P) :- - (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !, + (var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !, ( M1 = M -> '$assert_dynamic'((C:-G),M1,Where,R,P) ; @@ -91,33 +91,33 @@ assert(C) :- '$assertat_d'(Where,H,B,C0,Mod,R) ; functor(H,Na,Ar), - throw(error(permission_error(modify,static_procedure,Na/Ar),P)) + '$do_error'(permission_error(modify,static_procedure,Na/Ar),P) ). assert_static(V) :- var(V), !, - throw(error(instantiation_error,assert_static(V))). + '$do_error'(instantiation_error,assert_static(V)). assert_static(C) :- '$current_module'(Mod), '$assert_static'(C,Mod,last,_,assert_static(C)). asserta_static(V) :- var(V), !, - throw(error(instantiation_error,asserta_static(V))). + '$do_error'(instantiation_error,asserta_static(V)). asserta_static(C) :- '$current_module'(Mod), '$assert_static'(C,Mod,first,_,asserta_static(C)). assertz_static(V) :- var(V), !, - throw(error(instantiation_error,assertz_static(V))). + '$do_error'(instantiation_error,assertz_static(V)). assertz_static(C) :- '$current_module'(Mod), '$assert_static'(C,Mod,last,_,assertz_static(C)). '$assert_static'(V,M,_,_,_) :- var(V), !, - throw(error(instantiation_error,assert(M:V))). + '$do_error'(instantiation_error,assert(M:V)). '$assert_static'(M:C,_,Where,R,P) :- !, '$assert_static'(C,M,Where,R,P). '$assert_static'((H:-G),M1,Where,R,P) :- - (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !, + (var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !, ( M1 = M -> '$assert_static'((C:-G),M1,Where,R,P) ; @@ -128,7 +128,7 @@ assertz_static(C) :- '$expand_clause'(CI,C0,C,Mod), '$check_head_and_body'(C,H,B,P), ( '$is_dynamic'(H, Mod) -> - throw(error(permission_error(modify,dynamic_procedure,Na/Ar),P)) + '$do_error'(permission_error(modify,dynamic_procedure,Na/Ar),P) ; '$undefined'(H,Mod), '$get_value'('$full_iso',true) -> functor(H,Na,Ar), '$dynamic'(Na/Ar, Mod), '$assertat_d'(Where,H,B,C0,Mod,R) @@ -212,19 +212,19 @@ assertz_static(C) :- '$erase_all_mf_dynamic'(_,_,_). asserta(V,R) :- var(V), !, - throw(error(instantiation_error,asserta(V,R))). + '$do_error'(instantiation_error,asserta(V,R)). asserta(C,R) :- '$current_module'(M), '$assert_dynamic'(C,M,first,R,asserta(C,R)). assertz(V,R) :- var(V), !, - throw(error(instantiation_error,assertz(V,R))). + '$do_error'(instantiation_error,assertz(V,R)). assertz(C,R) :- '$current_module'(M), '$assert_dynamic'(C,M,last,R,assertz(C,R)). assert(V,R) :- var(V), !, - throw(error(instantiation_error,assert(V,R))). + '$do_error'(instantiation_error,assert(V,R)). assert(C,R) :- '$current_module'(M), '$assert_dynamic'(C,M,last,R,assert(C,R)). @@ -234,11 +234,11 @@ clause(V,Q) :- '$clause'(V,M,Q). '$clause'(V,M,Q) :- var(V), !, - throw(error(instantiation_error,M:clause(V,Q))). + '$do_error'(instantiation_error,M:clause(V,Q)). '$clause'(C,M,Q) :- number(C), !, - throw(error(type_error(callable,C),M:clause(C,Q))). + '$do_error'(type_error(callable,C),M:clause(C,Q)). '$clause'(R,M,Q) :- db_reference(R), !, - throw(error(type_error(callable,R),M:clause(R,Q))). + '$do_error'(type_error(callable,R),M:clause(R,Q)). '$clause'(M:P,_,Q) :- !, '$clause'(P,M,Q). '$clause'(P,Mod,Q) :- '$is_dynamic'(P, Mod), !, @@ -250,19 +250,19 @@ clause(V,Q) :- ( '$system_predicate'(P,M) -> true ; '$number_of_clauses'(P,M,N), N > 0 ), functor(P,Name,Arity), - throw(error(permission_error(access,private_procedure,Name/Arity), - clause(M:P,Q))). + '$do_error'(permission_error(access,private_procedure,Name/Arity), + clause(M:P,Q)). clause(V,Q,R) :- '$current_module'(V,M,Q,R), '$clause'(V,M,Q,R). '$clause'(V,M,Q,R) :- var(V), !, - throw(error(instantiation_error,M:clause(V,Q,R))). + '$do_error'(instantiation_error,M:clause(V,Q,R)). '$clause'(C,M,Q,R) :- number(C), !, - throw(error(type_error(callable,C),clause(C,M:Q,R))). + '$do_error'(type_error(callable,C),clause(C,M:Q,R)). '$clause'(R,M,Q,R1) :- db_reference(R), !, - throw(error(type_error(callable,R),clause(R,M:Q,R1))). + '$do_error'(type_error(callable,R),clause(R,M:Q,R1)). '$clause'(M:P,_,Q,R) :- !, '$clause'(P,M,Q,R). '$clause'(P,Mod,Q,R) :- @@ -270,8 +270,8 @@ clause(V,Q,R) :- '$recordedp'(Mod:P,(P:-Q),R) ; functor(P,N,A), - throw(error(permission_error(access,private_procedure,N/A), - clause(Mod:P,Q,R))) + '$do_error'(permission_error(access,private_procedure,N/A), + clause(Mod:P,Q,R)) ). retract(C) :- @@ -280,7 +280,7 @@ retract(C) :- '$retract'(V,_) :- var(V), !, - throw(error(instantiation_error,retract(V))). + '$do_error'(instantiation_error,retract(V)). '$retract'(M:C,_) :- !, '$retract'(C,M). '$retract'(C,M) :- @@ -295,7 +295,7 @@ retract(C) :- fail. '$retract'(C,M) :- '$fetch_predicate_indicator_from_clause'(C, PI), - throw(error(permission_error(modify,static_procedure,PI),retract(M:C))). + '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). retract(C,R) :- !, '$current_module'(M), @@ -303,7 +303,7 @@ retract(C,R) :- !, '$retract'(V,M,R) :- var(V), !, - throw(error(instantiation_error,retract(M:V,R))). + '$do_error'(instantiation_error,retract(M:V,R)). '$retract'(M:C,_,R) :- !, '$retract'(C,M,R). '$retract'(C, M, R) :- @@ -324,7 +324,7 @@ retract(C,R) :- !, fail. '$retract'(C,M,_) :- '$fetch_predicate_indicator_from_clause'(C, PI), - throw(error(permission_error(modify,static_procedure,PI),retract(M:C))). + '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). '$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !, functor(C, Na, Ar). @@ -337,7 +337,7 @@ retractall(V) :- !, '$retractall'(V,M). '$retractall'(V,M) :- var(V), !, - throw(error(instantiation_error,retract(M:V))). + '$do_error'(instantiation_error,retract(M:V)). '$retractall'(M:V,_) :- !, '$retractall'(V,M). '$retractall'(T,M) :- @@ -347,7 +347,7 @@ retractall(V) :- !, '$retractall'(T,M) :- \+ '$is_dynamic'(T,M), !, functor(T,Na,Ar), - throw(error(permission_error(modify,static_procedure,Na/Ar),retractall(T))). + '$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T)). '$retractall'(T,M) :- '$erase_all_clauses_for_dynamic'(T, M). @@ -364,9 +364,9 @@ abolish(N,A) :- '$abolish'(N,A,Mod). '$abolish'(N,A,M) :- var(N), !, - throw(error(instantiation_error,abolish(M:N,A))). + '$do_error'(instantiation_error,abolish(M:N,A)). '$abolish'(N,A,M) :- var(A), !, - throw(error(instantiation_error,abolish(M:N,A))). + '$do_error'(instantiation_error,abolish(M:N,A)). '$abolish'(N,A,M) :- ( '$recorded'('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ), fail. @@ -396,9 +396,9 @@ abolish(X) :- functor(T, Na, Ar), '$undefined'(T, M), !. '$new_abolish'(Na/Ar, M) :- - throw(error(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar))). + '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)). '$new_abolish'(T, M) :- - throw(error(type_error(predicate_indicator,T),abolish(M:T))). + '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$abolish_all'(M) :- '$current_predicate'(M,Na,Ar), @@ -414,49 +414,49 @@ abolish(X) :- '$check_error_in_predicate_indicator'(V, Msg) :- var(V), !, - throw(error(instantiation_error, Msg)). + '$do_error'(instantiation_error, Msg). '$check_error_in_predicate_indicator'(M:S, Msg) :- !, '$check_error_in_module'(M, Msg), '$check_error_in_predicate_indicator'(S, Msg). '$check_error_in_predicate_indicator'(S, Msg) :- S \= _/_, !, - throw(error(type_error(predicate_indicator,S), Msg)). + '$do_error'(type_error(predicate_indicator,S), Msg). '$check_error_in_predicate_indicator'(Na/_, Msg) :- var(Na), !, - throw(error(instantiation_error, Msg)). + '$do_error'(instantiation_error, Msg). '$check_error_in_predicate_indicator'(Na/_, Msg) :- \+ atom(Na), !, - throw(error(type_error(atom,Na), Msg)). + '$do_error'(type_error(atom,Na), Msg). '$check_error_in_predicate_indicator'(_/Ar, Msg) :- var(Ar), !, - throw(error(instantiation_error, Msg)). + '$do_error'(instantiation_error, Msg). '$check_error_in_predicate_indicator'(_/Ar, Msg) :- \+ integer(Ar), !, - throw(error(type_error(integer,Ar), Msg)). + '$do_error'(type_error(integer,Ar), Msg). '$check_error_in_predicate_indicator'(_/Ar, Msg) :- Ar < 0, !, - throw(error(domain_error(not_less_than_zero,Ar), Msg)). + '$do_error'(domain_error(not_less_than_zero,Ar), Msg). % not yet implemented! %'$check_error_in_predicate_indicator'(Na/Ar, Msg) :- % Ar < maxarity, !, -% throw(error(type_error(representation_error(max_arity),Ar), Msg)). +% '$do_error'(type_error(representation_error(max_arity),Ar), Msg). '$check_error_in_module'(M, Msg) :- var(M), !, - throw(error(instantiation_error, Msg)). + '$do_error'(instantiation_error, Msg). '$check_error_in_module'(M, Msg) :- \+ atom(M), !, - throw(error(type_error(atom,M), Msg)). + '$do_error'(type_error(atom,M), Msg). '$old_abolish'(V,M) :- var(V), !, ( '$access_yap_flags'(8, 1) -> - throw(error(instantiation_error,abolish(M:V))) + '$do_error'(instantiation_error,abolish(M:V)) ; '$abolish_all_old'(M) ). '$old_abolish'(A,M) :- atom(A), !, ( '$access_yap_flags'(8, 1) -> - throw(error(type_error(predicate_indicator,A),abolish(M:A))) + '$do_error'(type_error(predicate_indicator,A),abolish(M:A)) ; '$abolish_all_atoms_old'(A,M) ). @@ -467,7 +467,7 @@ abolish(X) :- '$old_abolish'(N/A, M) :- !, '$abolish'(N, A, M). '$old_abolish'(T, M) :- - throw(error(type_error(predicate_indicator,T),abolish(M:T))). + '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$abolish_all_old'(M) :- '$current_predicate'(M, Na, Ar), @@ -487,7 +487,7 @@ abolish(X) :- '$abolishs'(G, M) :- '$system_predicate'(G,M), !, functor(G,Name,Arity), - throw(error(permission_error(modify,static_procedure,Name/Arity),abolish(M:G))). + '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). '$abolishs'(G, Module) :- '$access_yap_flags'(8, 2), % only do this in sicstus mode '$undefined'(G, Module), @@ -499,7 +499,7 @@ abolish(X) :- '$abolishs'(G, Module) :- '$has_yap_or', !, functor(G,A,N), - throw(error(permission_error(modify,static_procedure,A/N),abolish(Module:G))). + '$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)). '$abolishs'(G, M) :- '$purge_clauses'(G, M), '$recordedp'(M:G,_,R), erase(R), fail. @@ -512,10 +512,10 @@ dynamic(X) :- '$access_yap_flags'(8, 0), !, '$current_module'(M), '$dynamic'(X, M). dynamic(X) :- - throw(error(context_error(dynamic(X),declaration),query)). + '$do_error'(context_error(dynamic(X),declaration),query). '$dynamic'(X,M) :- var(X), !, - throw(error(instantiation_error,dynamic(M:X))). + '$do_error'(instantiation_error,dynamic(M:X)). '$dynamic'(Mod:Spec,_) :- !, '$dynamic'(Spec,Mod). '$dynamic'([], _) :- !. @@ -532,10 +532,10 @@ dynamic(X) :- '$is_dynamic'(T,Mod) -> true; F /\ 16'400 =:= 16'400, '$undefined'(T,Mod) -> F1 is F /\ \(0x600), NF is F1 \/ 16'2000, '$flags'(T,Mod,F,NF); F/\16'8 =:= 16'8 -> true ; - throw(error(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))) + '$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N)) ). '$dynamic2'(X,Mod) :- - throw(error(type_error(callable,X),dynamic(Mod:X))). + '$do_error'(type_error(callable,X),dynamic(Mod:X)). '$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !, @@ -544,10 +544,10 @@ dynamic(X) :- '$is_dynamic'(T,Mod) -> true; F /\ 16'400 =:= 16'400 , '$undefined'(T,Mod) -> NF is F \/ 0x8, '$flags'(T,Mod,F,NF); F /\ 16'8=:= 16'8 -> true ; - throw(error(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))) + '$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N)) ). '$logical_updatable'(X,Mod) :- - throw(error(type_error(callable,X),dynamic(Mod:X))). + '$do_error'(type_error(callable,X),dynamic(Mod:X)). dynamic_predicate(P,Sem) :- @@ -561,10 +561,10 @@ dynamic_predicate(P,Sem) :- '$bad_if_is_semantics'(Sem, Goal) :- var(Sem), !, - throw(error(instantiation_error,Goal)). + '$do_error'(instantiation_error,Goal). '$bad_if_is_semantics'(Sem, Goal) :- Sem \= immediate, Sem \= logical, !, - throw(error(domain_error(semantics_indicator,Sem),Goal)). + '$do_error'(domain_error(semantics_indicator,Sem),Goal). '$expand_clause'(C0,C1,C2,Mod) :- @@ -576,7 +576,7 @@ dynamic_predicate(P,Sem) :- ). '$public'(X, _) :- var(X), !, - throw(error(instantiation_error,public(X))). + '$do_error'(instantiation_error,public(X)). '$public'(Mod:Spec, _) :- !, '$public'(Spec,Mod). '$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M). @@ -586,7 +586,7 @@ dynamic_predicate(P,Sem) :- functor(T,A,N), '$do_make_public'(T, Mod). '$public'(X, Mod) :- - throw(error(type_error(callable,X),dynamic(Mod:X))). + '$do_error'(type_error(callable,X),dynamic(Mod:X)). '$do_make_public'(T, Mod) :- '$is_dynamic'(T, Mod), !. % all dynamic predicates are public. @@ -602,7 +602,7 @@ dynamic_predicate(P,Sem) :- F\/16'400000 \== 0. hide_predicate(V) :- var(V), !, - throw(error(instantiation_error,hide_predicate(X))). + '$do_error'(instantiation_error,hide_predicate(X)). hide_predicate(M:P) :- !, '$hide_predicate2'(P, M). hide_predicate(P) :- @@ -610,12 +610,12 @@ hide_predicate(P) :- '$hide_predicate2'(M, P). '$hide_predicate2'(V, M) :- var(V), !, - throw(error(instantiation_error,hide_predicate(M:V))). + '$do_error'(instantiation_error,hide_predicate(M:V)). '$hide_predicate2'(N/A, M) :- !, functor(S,N,A), '$hide_predicate'(S, M) . '$hide_predicate2'(PredDesc, M) :- - throw(error(type_error(predicate_indicator,T),hide_predicate(M:PredDesc))). + '$do_error'(type_error(predicate_indicator,T),hide_predicate(M:PredDesc)). diff --git a/pl/profile.yap b/pl/profile.yap index 530ab1b6e..4be13d002 100644 --- a/pl/profile.yap +++ b/pl/profile.yap @@ -20,7 +20,7 @@ profile_data(P, Parm, Data) :- P = M:D, !, ( var(M) -> - throw(error(instantiation_error,profile_data(M:D, Parm, Data))) + '$do_error'(instantiation_error,profile_data(M:D, Parm, Data)) ; '$profile_data'(D, Parm, Data, M) ). diff --git a/pl/setof.yap b/pl/setof.yap index 2f4b836d1..8524c24e1 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -220,5 +220,5 @@ all(T,G,S) :- '$recorda'('$$one','$',R), ( '$check_list_for_bags'([_|B], T) :- !, '$check_list_for_bags'(B,T). '$check_list_for_bags'(S, T) :- - throw(error(type_error(list,S),T)). + '$do_error'(type_error(list,S),T). diff --git a/pl/sockets.yap b/pl/sockets.yap index 8f36a893f..ae718efa0 100644 --- a/pl/sockets.yap +++ b/pl/sockets.yap @@ -33,12 +33,12 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :- /* check whether a list of options is valid */ '$check_list_for_sockets'(V,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_list_for_sockets'([],_) :- !. '$check_list_for_sockets'([_|T],G) :- !,   '$check_list_for_sockets'(T,G). '$check_list_for_sockets'(T,G) :- - throw(error(type_error(list,T),G)). + '$do_error'(type_error(list,T),G). '$select_cp_fds'([], Fds, Fds). '$select_cp_fds'([_-Fd|L], Fds0, [Fd|Fds]) :- @@ -46,7 +46,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :- '$check_select_time'(V, _, _, Goal) :- var(V), !, - throw(error(instantiation_error,Goal)). + '$do_error'(instantiation_error,Goal). '$check_select_time'(off, -1, -1, _). '$check_select_time'(Sec0:USec0, Sec, USec, _) :- Sec is Sec0, @@ -68,7 +68,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :- socket_buffering(Sock, Flag, InSize, OutSize) :- var(OutSize), OutSize \= InSize, !, - throw(error(instantiation_error,socket_buffering(Sock, Flag, InSize, OutSize))). + '$do_error'(instantiation_error,socket_buffering(Sock, Flag, InSize, OutSize)). socket_buffering(Sock, Flag, InSize, OutSize) :- '$convert_sock_buff'(OutSize, OutNumb), '$socket_buffering'(Sock, Flag, InNumb, OutNumb), diff --git a/pl/strict_iso.yap b/pl/strict_iso.yap index bbef4aa56..4c6196b3a 100644 --- a/pl/strict_iso.yap +++ b/pl/strict_iso.yap @@ -1,9 +1,9 @@ '$iso_check_goal'(V,G) :- var(V), !, - throw(error(instantiation_error,call(G))). + '$do_error'(instantiation_error,call(G)). '$iso_check_goal'(V,G) :- number(V), !, - throw(error(type_error(callable,V),G)). + '$do_error'(type_error(callable,V),G). '$iso_check_goal'(_:G,G0) :- !, '$iso_check_goal'(G,G0). '$iso_check_goal'((G1,G2),G0) :- !, @@ -18,7 +18,7 @@ '$iso_check_goal'(!,_) :- !. '$iso_check_goal'((G1|G2),G0) :- '$access_yap_flags'(9,1), !, - throw(error(domain_error(builtin_procedure,(G1|G2)), call(G0))). + '$do_error'(domain_error(builtin_procedure,(G1|G2)), call(G0)). '$iso_check_goal'((G1|G2),G0) :- !, '$iso_check_a_goal'(G1,(G1|G2),G0), '$iso_check_a_goal'(G2,(G1|G2),G0). @@ -30,16 +30,16 @@ -> true ; - throw(error(domain_error(builtin_procedure,G), call(G0))) + '$do_error'(domain_error(builtin_procedure,G), call(G0)) ). '$iso_check_goal'(_,_). '$iso_check_a_goal'(V,_,G) :- var(V), !, - throw(error(instantiation_error,call(G))). + '$do_error'(instantiation_error,call(G)). '$iso_check_a_goal'(V,E,G) :- number(V), !, - throw(error(type_error(callable,E),call(G))). + '$do_error'(type_error(callable,E),call(G)). '$iso_check_a_goal'(_:G,E,G0) :- !, '$iso_check_a_goal'(G,E,G0). '$iso_check_a_goal'((G1,G2),E,G0) :- !, @@ -54,7 +54,7 @@ '$iso_check_a_goal'(!,_,_) :- !. '$iso_check_a_goal'((_|_),E,G0) :- '$access_yap_flags'(9,1), !, - throw(error(domain_error(builtin_procedure,E), call(G0))). + '$do_error'(domain_error(builtin_procedure,E), call(G0)). '$iso_check_a_goal'((_|_),_,_) :- !. '$iso_check_a_goal'(G,_,G0) :- '$access_yap_flags'(9,1), @@ -64,7 +64,7 @@ -> true ; - throw(error(domain_error(builtin_procedure,G), call(G0))) + '$do_error'(domain_error(builtin_procedure,G), call(G0)) ). '$iso_check_a_goal'(_,_,_). @@ -93,7 +93,7 @@ '$check_iso_system_goal'(G) :- '$iso_builtin'(G), !. '$check_iso_system_goal'(G) :- - throw(error(domain_error(builtin_procedure,G), G)). + '$do_error'(domain_error(builtin_procedure,G), G). '$iso_builtin'(abolish(_)). diff --git a/pl/tabling.yap b/pl/tabling.yap index ae52b0041..7ef396827 100644 --- a/pl/tabling.yap +++ b/pl/tabling.yap @@ -82,7 +82,7 @@ show_trie(X) :- '$show_trie'(X, M). '$show_trie'(X, M) :- var(X), !, - throw(error(instantiation_error,show_trie(M:X))). + '$do_error'(instantiation_error,show_trie(M:X)). '$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M). '$show_trie'(M:A, _) :- !, '$show_trie'(A, M). '$show_trie'(A/N, M) :- integer(N), atom(A), !, diff --git a/pl/utils.yap b/pl/utils.yap index 96a71fe71..c908699b8 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -26,99 +26,99 @@ if(_X,_Y,Z) :- '$execute'(Z). -call_with_args(V) :- var(V), !, - throw(error(instantiation_error,call_with_args(V))). +call_with_args(M:V) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V)). call_with_args(M:A) :- !, '$call_with_args'(A,M). call_with_args(A) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,M). call_with_args(A) :- - throw(error(type_error(atom,A),call_with_args(A))). + '$do_error'(type_error(atom,A),call_with_args(A)). -call_with_args(V,A1) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1))). +call_with_args(M:V,A1) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1)). call_with_args(M:A,A1) :- !, '$call_with_args'(A,A1,M). call_with_args(A,A1) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,M). call_with_args(A,A1) :- - throw(error(type_error(atom,A),call_with_args(A,A1))). + '$do_error'(type_error(atom,A),call_with_args(A,A1)). -call_with_args(V,A1,A2) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2))). +call_with_args(M:V,A1,A2) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2)). call_with_args(M:A,A1,A2) :- !, '$call_with_args'(A,A1,A2,M). call_with_args(A,A1,A2) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,M). call_with_args(A,A1,A2) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2)). -call_with_args(V,A1,A2,A3) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3))). +call_with_args(M:V,A1,A2,A3) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3)). call_with_args(M:A,A1,A2,A3) :- !, '$call_with_args'(A,A1,A2,A3,M). call_with_args(A,A1,A2,A3) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,M). call_with_args(A,A1,A2,A3) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3)). -call_with_args(V,A1,A2,A3,A4) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4))). +call_with_args(M:V,A1,A2,A3,A4) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4)). call_with_args(M:A,A1,A2,A3,A4) :- !, '$call_with_args'(A,A1,A2,A3,A4,M). call_with_args(A,A1,A2,A3,A4) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,M). call_with_args(A,A1,A2,A3,A4) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4)). -call_with_args(V,A1,A2,A3,A4,A5) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5))). +call_with_args(M:V,A1,A2,A3,A4,A5) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5)). call_with_args(M:A,A1,A2,A3,A4,A5) :- !, '$call_with_args'(A,A1,A2,A3,A4,A5,M). call_with_args(A,A1,A2,A3,A4,A5) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,M). call_with_args(A,A1,A2,A3,A4,A5) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5)). -call_with_args(V,A1,A2,A3,A4,A5,A6) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6))). +call_with_args(M:V,A1,A2,A3,A4,A5,A6) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6)). call_with_args(M:A,A1,A2,A3,A4,A5,A6) :- !, '$call_with_args'(A,A1,A2,A3,A4,A5,A6,M). call_with_args(A,A1,A2,A3,A4,A5,A6) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,A6,M). call_with_args(A,A1,A2,A3,A4,A5,A6) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6)). -call_with_args(V,A1,A2,A3,A4,A5,A6,A7) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7))). +call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7)). call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7) :- !, '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7)). -call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8))). +call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8)). call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8) :- !, '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8)). -call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9))). +call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9)). call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M). @@ -126,56 +126,56 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9)). -call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- var(V), !, - throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10))). +call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- var(V), !, + '$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)). call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- !, '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- atom(A), !, '$current_module'(M), '$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,M). call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- - throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10))). + '$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)). op(P,T,V) :- var(P), !, - throw(error(instantiation_error,op(P,T,V))). + '$do_error'(instantiation_error,op(P,T,V)). op(P,T,V) :- \+integer(P), !, - throw(error(type_error(integer,P),op(P,T,V))). + '$do_error'(type_error(integer,P),op(P,T,V)). op(P,T,V) :- (P < 0 ; P > 1200), !, - throw(error(domain_error(operator_priority,P),op(P,T,V))). + '$do_error'(domain_error(operator_priority,P),op(P,T,V)). op(P,T,V) :- var(T), !, - throw(error(instantiation_error,op(P,T,V))). + '$do_error'(instantiation_error,op(P,T,V)). op(P,T,V) :- \+atom(T), !, - throw(error(type_error(atom,T),op(P,T,V))). + '$do_error'(type_error(atom,T),op(P,T,V)). op(P,T,V) :- var(V), !, - throw(error(instantiation_error,op(P,T,V))). + '$do_error'(instantiation_error,op(P,T,V)). op(P,T,V) :- \+ atom(V), \+ '$check_list_of_operators'(V, op(P,T,V)), - throw(error(type_error(list,V),op(P,T,V))). + '$do_error'(type_error(list,V),op(P,T,V)). op(P,T,V) :- '$op2'(P,T,V). '$check_list_of_operators'(V, T) :- var(V), !, - throw(error(instantiation_error,T)). + '$do_error'(instantiation_error,T). '$check_list_of_operators'([], _). '$check_list_of_operators'([H|L], T) :- '$check_if_operator'(H,T), '$check_list_of_operators'(L, T). '$check_if_operator'(H,T) :- var(H), !, - throw(error(instantiation_error,T)). + '$do_error'(instantiation_error,T). '$check_if_operator'(H,_) :- atom(H), !. '$check_if_operator'(H,T) :- - throw(error(type_error(atom,H),T)). + '$do_error'(type_error(atom,H),T). '$op2'(_,_,[]) :- !. '$op2'(P,T,[A|L]) :- !, '$op'(P,T,A), '$op2'(P,T,L). '$op2'(P,T,A) :- atom(A), '$op'(P,T,A). '$op'(P,T,',') :- !, - throw(error(permission_error(modify,operator,','),op(P,T,','))). + '$do_error'(permission_error(modify,operator,','),op(P,T,',')). '$op'(P,T,A) :- '$opdec'(P,T,A). %%% Operating System utilities @@ -193,28 +193,28 @@ rename(Old,New) :- atom(Old), atom(New), !, '$rename'(SOld,SNew). unix(V) :- var(V), !, - throw(error(instantiation_error,unix(V))). + '$do_error'(instantiation_error,unix(V)). unix(argv(L)) :- '$is_list_of_atoms'(L,L), !, '$argv'(L). unix(argv(V)) :- - throw(error(type_error(atomic,V),unix(argv(V)))). + '$do_error'(type_error(atomic,V),unix(argv(V))). unix(cd) :- cd('~'). unix(cd(V)) :- var(V), !, - throw(error(instantiation_error,unix(cd(V)))). + '$do_error'(instantiation_error,unix(cd(V))). unix(cd(A)) :- atomic(A), !, cd(A). unix(cd(V)) :- - throw(error(type_error(atomic,V),unix(cd(V)))). + '$do_error'(type_error(atomic,V),unix(cd(V))). unix(environ(X,Y)) :- '$do_environ'(X,Y). unix(getcwd(X)) :- getcwd(X). unix(shell(V)) :- var(V), !, - throw(error(instantiation_error,unix(shell(V)))). + '$do_error'(instantiation_error,unix(shell(V))). unix(shell(A)) :- atomic(A), !, '$shell'(A). unix(shell(V)) :- - throw(error(type_error(atomic,V),unix(shell(V)))). + '$do_error'(type_error(atomic,V),unix(shell(V))). unix(system(V)) :- var(V), !, - throw(error(instantiation_error,unix(system(V)))). + '$do_error'(instantiation_error,unix(system(V))). unix(system(A)) :- atomic(A), !, system(A). unix(system(V)) :- - throw(error(type_error(atom,V),unix(system(V)))). + '$do_error'(type_error(atom,V),unix(system(V))). unix(shell) :- sh. unix(putenv(X,Y)) :- '$putenv'(X,Y). @@ -225,23 +225,23 @@ unix(putenv(X,Y)) :- '$putenv'(X,Y). '$check_if_head_may_be_atom'(H,L0), '$is_list_of_atoms'(L,L0). '$is_list_of_atoms'(H,L0) :- - throw(error(type_error(list,H),unix(argv(L0)))). + '$do_error'(type_error(list,H),unix(argv(L0))). '$check_if_head_may_be_atom'(H,L0) :- var(H), !. '$check_if_head_may_be_atom'(H,L0) :- atom(H), !. '$check_if_head_may_be_atom'(H,L0) :- - throw(error(type_error(atom,H),unix(argv(L0)))). + '$do_error'(type_error(atom,H),unix(argv(L0))). '$do_environ'(X, Y) :- var(X), !, - throw(error(instantiation_error,unix(environ(X,Y)))). + '$do_error'(instantiation_error,unix(environ(X,Y))). '$do_environ'(X, Y) :- atom(X), !, '$getenv'(X,Y). '$do_environ'(X, Y) :- - throw(error(type_error(atom,X),unix(environ(X,Y)))). + '$do_error'(type_error(atom,X),unix(environ(X,Y))). putenv(Na,Val) :- @@ -270,26 +270,26 @@ on_signal(Signal,OldAction,Action) :- %%% Saving and restoring a computation save(A) :- var(A), !, - throw(error(instantiation_error,save(A))). + '$do_error'(instantiation_error,save(A)). save(A) :- atom(A), !, name(A,S), '$save'(S). save(S) :- '$save'(S). save(A,_) :- var(A), !, - throw(error(instantiation_error,save(A))). + '$do_error'(instantiation_error,save(A)). save(A,OUT) :- atom(A), !, name(A,S), '$save'(S,OUT). save(S,OUT) :- '$save'(S,OUT). save_program(A) :- var(A), !, - throw(error(instantiation_error,save_program(A))). + '$do_error'(instantiation_error,save_program(A)). save_program(A) :- atom(A), !, name(A,S), '$save_program'(S). save_program(S) :- '$save_program'(S). save_program(A, G) :- var(A), !, - throw(error(instantiation_error,save_program(A,G))). + '$do_error'(instantiation_error,save_program(A,G)). save_program(A, G) :- var(G), !, - throw(error(instantiation_error,save_program(A,G))). + '$do_error'(instantiation_error,save_program(A,G)). save_program(A, G) :- \+ callable(G), !, - throw(error(type_error(callable,G),save_program(A,G))). + '$do_error'(type_error(callable,G),save_program(A,G)). save_program(A, G) :- ( atom(A) -> name(A,S) ; A = S), '$recorda'('$restore_goal',G,R), @@ -299,7 +299,7 @@ save_program(A, G) :- save_program(_,_). restore(A) :- var(A), !, - throw(error(instantiation_error,restore(A))). + '$do_error'(instantiation_error,restore(A)). restore(A) :- atom(A), !, name(A,S), '$restore'(S). restore(S) :- '$restore'(S). @@ -378,7 +378,7 @@ system_predicate(P) :- functor(T,A,Arity), '$pred_exists'(T,M). '$current_predicate3'(M,BadSpec) :- % only for the predicate - throw(error(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec))). + '$do_error'(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec)). %%% User interface for statistics @@ -500,7 +500,7 @@ unknown(V0,V) :- '$valid_unknown_handler'(V,_) :- var(V), !, - throw(error(instantiation_error,yap_flag(unknown,V))). + '$do_error'(instantiation_error,yap_flag(unknown,V)). '$valid_unknown_handler'(fail,_) :- !. '$valid_unknown_handler'(error,_) :- !. '$valid_unknown_handler'(warning,_) :- !. @@ -511,7 +511,7 @@ unknown(V0,V) :- \+ '$undefined'(S,M), !. '$valid_unknown_handler'(S,_) :- - throw(error(domain_error(flag_value,unknown+S),yap_flag(unknown,S))). + '$do_error'(domain_error(flag_value,unknown+S),yap_flag(unknown,S)). '$ask_unknown_flag'(Old) :- '$recorded'('$unknown','$unkonwn'(_,MyOld),_), !, @@ -532,7 +532,7 @@ unknown(V0,V) :- '$recorda'('$unknown','$unknown'(A,M:X),_). '$unknown_error'(P) :- - throw(error(unknown,P)). + '$do_error'(unknown,P). '$unknown_warning'(P) :- P=M:F, @@ -654,13 +654,13 @@ atom_concat(X,Y,At) :- sub_atom(At, Bef, Size, After, SubAt) :- var(At), !, - throw(error(instantiation_error,sub_atom(At, Bef, Size,After, SubAt))). + '$do_error'(instantiation_error,sub_atom(At, Bef, Size,After, SubAt)). sub_atom(At, Bef, Size, After, SubAt) :- \+ atom(At), !, - throw(error(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt))). + '$do_error'(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt)). sub_atom(At, Bef, Size, After, SubAt) :- nonvar(SubAt), \+ atom(SubAt), !, - throw(error(type_error(atom,SubAt),sub_atom(At, Bef, Size,After, SubAt))). + '$do_error'(type_error(atom,SubAt),sub_atom(At, Bef, Size,After, SubAt)). sub_atom(At, Bef, Size, After, SubAt) :- '$check_type_sub_atom'(Bef, sub_atom(At, Bef, Size,After, SubAt)), '$check_type_sub_atom'(Size, sub_atom(At, Bef, Size,After, SubAt)), @@ -674,10 +674,10 @@ sub_atom(At, Bef, Size, After, SubAt) :- var(I), !. '$check_type_sub_atom'(I, P) :- integer(I), I < 0, !, - throw(error(domain_error(not_less_than_zero,I),P)). + '$do_error'(domain_error(not_less_than_zero,I),P). '$check_type_sub_atom'(I, P) :- \+ integer(I), !, - throw(error(type_error(integer,I),P)). + '$do_error'(type_error(integer,I),P). '$check_type_sub_atom'(_, _). '$split_len_in_parts'(Atl, Len, Bef, Size, After, SubAt) :- @@ -743,11 +743,11 @@ initialization :- '$initialisation_goals'. prolog_initialization(G) :- var(G), !, - throw(error(instantiation_error,initialization(G))). + '$do_error'(instantiation_error,initialization(G)). prolog_initialization(T) :- callable(T), !, '$assert_init'(T). prolog_initialization(T) :- - throw(error(type_error(callable,T),initialization(T))). + '$do_error'(type_error(callable,T),initialization(T)). '$assert_init'(T) :- '$recordz'('$startup_goal',T,_), fail. '$assert_init'(_). @@ -755,10 +755,10 @@ prolog_initialization(T) :- version :- '$version'. version(V) :- var(V), !, - throw(error(instantiation_error,version(V))). + '$do_error'(instantiation_error,version(V)). version(T) :- atom(T), !, '$assert_version'(T). version(T) :- - throw(error(type_error(atom,T),version(T))). + '$do_error'(type_error(atom,T),version(T)). '$assert_version'(T) :- '$recordz'('$version',T,_), fail. '$assert_version'(_). diff --git a/pl/yapor.yap b/pl/yapor.yap index 68b90266e..104b67c79 100644 --- a/pl/yapor.yap +++ b/pl/yapor.yap @@ -70,7 +70,7 @@ default_sequential(_). fail. '$parallel_directive'(X,M) :- var(X), !, - throw(error(instantiation_error,parallel(M:X))). + '$do_error'(instantiation_error,parallel(M:X)). '$parallel_directive'((A,B),M) :- !, '$parallel_directive'(A,M), 'parallel_directive'(B,M). diff --git a/pl/yio.yap b/pl/yio.yap index efb32f8ae..69d107f53 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -18,11 +18,11 @@ /* stream predicates */ open(Source,M,T) :- var(Source), !, - throw(error(instantiation_error,open(Source,M,T))). + '$do_error'(instantiation_error,open(Source,M,T)). open(Source,M,T) :- var(M), !, - throw(error(instantiation_error,open(Source,M,T))). + '$do_error'(instantiation_error,open(Source,M,T)). open(Source,M,T) :- nonvar(T), !, - throw(error(type_error(variable,T),open(Source,M,T))). + '$do_error'(type_error(variable,T),open(Source,M,T)). open(File,Mode,Stream) :- '$open'(File,Mode,Stream,0). @@ -34,7 +34,7 @@ open(File,Mode,Stream) :- */ close(V) :- var(V), !, - throw(error(instantiation_error,close(V))). + '$do_error'(instantiation_error,close(V)). close(File) :- atom(File), !, ( @@ -50,7 +50,7 @@ close(Stream) :- '$close'(Stream). close(V,Opts) :- var(V), !, - throw(error(instantiation_error,close(V,Opts))). + '$do_error'(instantiation_error,close(V,Opts)). close(S,Opts) :- '$check_io_opts'(Opts,close(S,Opts)), /* YAP ignores the force/1 flag */ @@ -63,11 +63,11 @@ open(F,T,S,Opts) :- '$process_open_aliases'(Aliases,S). '$open2'(Source,M,T,N) :- var(Source), !, - throw(error(instantiation_error,open(Source,M,T,N))). + '$do_error'(instantiation_error,open(Source,M,T,N)). '$open2'(Source,M,T,N) :- var(M), !, - throw(error(instantiation_error,open(Source,M,T,N))). + '$do_error'(instantiation_error,open(Source,M,T,N)). '$open2'(Source,M,T,N) :- nonvar(T), !, - throw(error(type_error(variable,T),open(Source,M,T,N))). + '$do_error'(type_error(variable,T),open(Source,M,T,N)). '$open2'(File,Mode,Stream,N) :- '$open'(File,Mode,Stream,N). @@ -106,20 +106,20 @@ open(F,T,S,Opts) :- /* check whether a list of options is valid */ '$check_io_opts'(V,G) :- var(V), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_io_opts'([],_) :- !. '$check_io_opts'([H|_],G) :- var(H), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_io_opts'([Opt|T],G) :- !, '$check_opt'(G,Opt,G), '$check_io_opts'(T,G). '$check_io_opts'(T,G) :- - throw(error(type_error(list,T),G)). + '$do_error'(type_error(list,T),G). '$check_opt'(close(_,_),Opt,G) :- !, (Opt = force(X) -> '$check_force_opt_arg'(X,G) ; - throw(error(domain_error(close_option,Opt),G)) + '$do_error'(domain_error(close_option,Opt),G) ). '$check_opt'(open(_,_,_,_),Opt,G) :- !, '$check_opt_open'(Opt, G). @@ -140,7 +140,7 @@ open(F,T,S,Opts) :- '$check_opt_open'(eof_action(T), G) :- !, '$check_open_eof_action_arg'(T, G). '$check_opt_open'(A, G) :- - throw(error(domain_error(stream_option,A),G)). + '$do_error'(domain_error(stream_option,A),G). '$check_opt_read'(variables(_), _) :- !. '$check_opt_read'(variable_names(_), _) :- !. @@ -149,7 +149,7 @@ open(F,T,S,Opts) :- '$check_read_syntax_errors_arg'(T, G). '$check_opt_read'(term_position(_), G) :- !. '$check_opt_read'(A, G) :- - throw(error(domain_error(read_option,A),G)). + '$do_error'(domain_error(read_option,A),G). '$check_opt_sp'(file_name(_), _) :- !. '$check_opt_sp'(mode(_), _) :- !. @@ -162,7 +162,7 @@ open(F,T,S,Opts) :- '$check_opt_sp'(reposition(_), _) :- !. '$check_opt_sp'(type(_), _) :- !. '$check_opt_sp'(A, G) :- - throw(error(domain_error(stream_property,A),G)). + '$do_error'(domain_error(stream_property,A),G). '$check_opt_write'(quoted(T), G) :- !, '$check_write_quoted_arg'(T, G). @@ -175,93 +175,93 @@ open(F,T,S,Opts) :- '$check_opt_write'(max_depth(T), G) :- !, '$check_write_max_depth'(T, G). '$check_opt_write'(A, G) :- - throw(error(domain_error(write_option,A),G)). + '$do_error'(domain_error(write_option,A),G). % % check force arg % '$check_force_opt_arg'(X,G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_force_opt_arg'(true,_) :- !. '$check_force_opt_arg'(false,_) :- !. '$check_force_opt_arg'(X,G) :- - throw(error(domain_error(close_option,force(X)),G)). + '$do_error'(domain_error(close_option,force(X)),G). '$check_open_type_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_open_type_arg'(text,_) :- !. '$check_open_type_arg'(binary,_) :- !. '$check_open_opt_arg'(X,G) :- - throw(error(domain_error(io_mode,type(X)),G)). + '$do_error'(domain_error(io_mode,type(X)),G). '$check_open_reposition_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_open_reposition_arg'(true,_) :- !. '$check_open_reposition_arg'(false,_) :- !. '$check_open_reposition_arg'(X,G) :- - throw(error(domain_error(io_mode,reposition(X)),G)). + '$do_error'(domain_error(io_mode,reposition(X)),G). '$check_open_alias_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_open_alias_arg'(X,G) :- atom(X), !, ( '$check_if_valid_new_alias'(X), X \= user -> true ; - throw(error(permission_error(open, source_sink, alias(X)),G)) + '$do_error'(permission_error(open, source_sink, alias(X)),G) ). '$check_open_alias_arg'(X,G) :- - throw(error(domain_error(io_mode,alias(X)),G)). + '$do_error'(domain_error(io_mode,alias(X)),G). '$check_open_eof_action_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_open_eof_action_arg'(error,_) :- !. '$check_open_eof_action_arg'(eof_code,_) :- !. '$check_open_eof_action_arg'(reset,_) :- !. '$check_open_eof_action_arg'(X,G) :- - throw(error(domain_error(io_mode,eof_action(X)),G)). + '$do_error'(domain_error(io_mode,eof_action(X)),G). '$check_read_syntax_errors_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_read_syntax_errors_arg'(dec10,_) :- !. '$check_read_syntax_errors_arg'(fail,_) :- !. '$check_read_syntax_errors_arg'(error,_) :- !. '$check_read_syntax_errors_arg'(quiet,_) :- !. '$check_read_syntax_errors_arg'(X,G) :- - throw(error(domain_error(read_option,syntax_errors(X)),G)). + '$do_error'(domain_error(read_option,syntax_errors(X)),G). '$check_write_quoted_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_write_quoted_arg'(true,_) :- !. '$check_write_quoted_arg'(false,_) :- !. '$check_write_quoted_arg'(X,G) :- - throw(error(domain_error(write_option,write_quoted(X)),G)). + '$do_error'(domain_error(write_option,write_quoted(X)),G). '$check_write_ignore_ops_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_write_ignore_ops_arg'(true,_) :- !. '$check_write_ignore_ops_arg'(false,_) :- !. '$check_write_ignore_ops_arg'(X,G) :- - throw(error(domain_error(write_option,ignore_ops(X)),G)). + '$do_error'(domain_error(write_option,ignore_ops(X)),G). '$check_write_numbervars_arg'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_write_numbervars_arg'(true,_) :- !. '$check_write_numbervars_arg'(false,_) :- !. '$check_write_numbervars_arg'(X,G) :- - throw(error(domain_error(write_option,numbervars(X)),G)). + '$do_error'(domain_error(write_option,numbervars(X)),G). '$check_write_portrayed'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_write_portrayed'(true,_) :- !. '$check_write_portrayed'(false,_) :- !. '$check_write_portrayed'(X,G) :- - throw(error(domain_error(write_option,portrayed(X)),G)). + '$do_error'(domain_error(write_option,portrayed(X)),G). '$check_write_max_depth'(X, G) :- var(X), !, - throw(error(instantiation_error,G)). + '$do_error'(instantiation_error,G). '$check_write_max_depth'(I,_) :- integer(I), I > 0, !. '$check_write_max_depth'(X,G) :- - throw(error(domain_error(write_option,max_depth(X)),G)). + '$do_error'(domain_error(write_option,max_depth(X)),G). set_input(Stream) :- '$set_input'(Stream). @@ -280,7 +280,7 @@ exists(F) :- '$exists'(F,read). see(user) :- !, set_input(user_input). see(F) :- var(F), !, - throw(error(instantiation_error,see(F))). + '$do_error'(instantiation_error,see(F)). see(F) :- current_input(Stream), '$user_file_name'(Stream,F). see(F) :- current_stream(_,read,Stream), '$user_file_name'(Stream,F), !, @@ -297,7 +297,7 @@ seen :- current_input(Stream), '$close'(Stream), set_input(user). tell(user) :- !, set_output(user_output). tell(F) :- var(F), !, - throw(error(instantiation_error,tell(F))). + '$do_error'(instantiation_error,tell(F)). tell(F) :- current_output(Stream), '$user_file_name'(Stream,F), !. tell(F) :- current_stream(_,write,Stream), '$user_file_name'(Stream, F), !, @@ -524,34 +524,34 @@ get(N) :- current_input(S), '$get'(S,N). get_byte(V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_byte,V),get_byte(V))). + '$do_error'(type_error(in_byte,V),get_byte(V)). get_byte(V) :- current_input(S), '$get_byte'(S,V). get_byte(S,V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_byte,V),get_byte(S,V))). + '$do_error'(type_error(in_byte,V),get_byte(S,V)). get_byte(S,V) :- '$get_byte'(S,V). peek_byte(V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_byte,V),get_byte(V))). + '$do_error'(type_error(in_byte,V),get_byte(V)). peek_byte(V) :- current_input(S), '$peek_byte'(S,V). peek_byte(S,V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_byte,V),get_byte(S,V))). + '$do_error'(type_error(in_byte,V),get_byte(S,V)). peek_byte(S,V) :- '$peek_byte'(S,V). get_char(V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, - throw(error(type_error(in_character,V),get_char(V))). + '$do_error'(type_error(in_character,V),get_char(V)). get_char(V) :- current_input(S), '$get0'(S,I), @@ -560,7 +560,7 @@ get_char(V) :- get_char(S,V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, - throw(error(type_error(in_character,V),get_char(S,V))). + '$do_error'(type_error(in_character,V),get_char(S,V)). get_char(S,V) :- '$get0'(S,I), ( I = -1 -> V = end_of_file ; atom_codes(V,[I])). @@ -568,7 +568,7 @@ get_char(S,V) :- peek_char(V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, - throw(error(type_error(in_character,V),get_char(V))). + '$do_error'(type_error(in_character,V),get_char(V)). peek_char(V) :- current_input(S), '$peek'(S,I), @@ -577,89 +577,89 @@ peek_char(V) :- peek_char(S,V) :- \+ var(V), ( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, - throw(error(type_error(in_character,V),get_char(S,V))). + '$do_error'(type_error(in_character,V),get_char(S,V)). peek_char(S,V) :- '$peek'(S,I), ( I = -1 -> V = end_of_file ; atom_codes(V,[I])). get_code(S,V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_character_code,V),get_code(S,V))). + '$do_error'(type_error(in_character_code,V),get_code(S,V)). get_code(S,V) :- '$get0'(S,V). get_code(V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_character_code,V),get_code(V))). + '$do_error'(type_error(in_character_code,V),get_code(V)). get_code(V) :- current_input(S), '$get0'(S,V). peek_code(S,V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_character_code,V),get_code(S,V))). + '$do_error'(type_error(in_character_code,V),get_code(S,V)). peek_code(S,V) :- '$peek'(S,V). peek_code(V) :- \+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, - throw(error(type_error(in_character_code,V),get_code(V))). + '$do_error'(type_error(in_character_code,V),get_code(V)). peek_code(V) :- current_input(S), '$peek'(S,V). put_byte(V) :- var(V), !, - throw(error(instantiation_error,put_byte(V))). + '$do_error'(instantiation_error,put_byte(V)). put_byte(V) :- (\+ integer(V) ; V < 0 ; V > 256), !, - throw(error(type_error(byte,V),put_byte(V))). + '$do_error'(type_error(byte,V),put_byte(V)). put_byte(V) :- current_output(S), '$put_byte'(S,V). put_byte(S,V) :- var(V), !, - throw(error(instantiation_error,put_byte(S,V))). + '$do_error'(instantiation_error,put_byte(S,V)). put_byte(S,V) :- (\+ integer(V) ; V < 0 ; V > 256), !, - throw(error(type_error(byte,V),put_byte(S,V))). + '$do_error'(type_error(byte,V),put_byte(S,V)). put_byte(S,V) :- '$put_byte'(S,V). put_char(V) :- var(V), !, - throw(error(instantiation_error,put_char(V))). + '$do_error'(instantiation_error,put_char(V)). put_char(V) :- ( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !, - throw(error(type_error(character,V),put_char(V))). + '$do_error'(type_error(character,V),put_char(V)). put_char(V) :- current_output(S), atom_codes(V,[I]), '$put'(S,I). put_char(S,V) :- var(V), !, - throw(error(instantiation_error,put_char(S,V))). + '$do_error'(instantiation_error,put_char(S,V)). put_char(S,V) :- ( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !, - throw(error(type_error(character,V),put_char(S,V))). + '$do_error'(type_error(character,V),put_char(S,V)). put_char(S,V) :- atom_codes(V,[I]), '$put'(S,I). put_code(V) :- var(V), !, - throw(error(instantiation_error,put_code(V))). + '$do_error'(instantiation_error,put_code(V)). put_code(V) :- (\+ integer(V) ; V < 0 ; V > 256), !, - throw(error(type_error(character_code,V),put_code(V))). + '$do_error'(type_error(character_code,V),put_code(V)). put_code(V) :- current_output(S), '$put'(S,V). put_code(S,V) :- var(V), !, - throw(error(instantiation_error,put_code(S,V))). + '$do_error'(instantiation_error,put_code(S,V)). put_code(S,V) :- (\+ integer(V) ; V < 0 ; V > 256), !, - throw(error(type_error(character_code,V),put_code(S,V))). + '$do_error'(type_error(character_code,V),put_code(S,V)). put_code(S,V) :- '$put'(S,V). @@ -768,7 +768,7 @@ stream_position(S,N,M) :- set_stream_position(S,N) :- var(S), !, - throw(error(instantiation_error, set_stream_position(S, N))). + '$do_error'(instantiation_error, set_stream_position(S, N)). set_stream_position(user,N) :- !, '$set_stream_position'(user_input,N). set_stream_position(A,N) :- @@ -789,7 +789,7 @@ stream_property(Stream, Props) :- '$current_stream'(_,_,Stream), !, '$stream_property'(Stream, Props). stream_property(Stream, Props) :- - throw(error(domain_error(stream,Stream),stream_property(Stream, Props))). + '$do_error'(domain_error(stream,Stream),stream_property(Stream, Props)). '$generate_prop'(file_name(_F)). '$generate_prop'(mode(_M)). @@ -804,7 +804,7 @@ stream_property(Stream, Props) :- '$stream_property'(Stream, Props) :- var(Props), !, - throw(error(instantiation_error, stream_properties(Stream, Props))). + '$do_error'(instantiation_error, stream_properties(Stream, Props)). '$stream_property'(Stream, Props0) :- '$check_stream_props'(Props0, Props), '$check_io_opts'(Props, stream_property(Stream, Props)), @@ -882,7 +882,7 @@ at_end_of_stream(S) :- consult_depth(LV) :- '$show_consult_level'(LV). absolute_file_name(V,Out) :- var(V), !, - throw(error(instantiation_error, absolute_file_name(V, Out))). + '$do_error'(instantiation_error, absolute_file_name(V, Out)). absolute_file_name(user,user) :- !. absolute_file_name(RelFile,AbsFile) :- '$find_in_path'(RelFile,PathFile,absolute_file_name(RelFile,AbsFile)),