/************************************************************************* * * * YAP Prolog * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- * * * ************************************************************************** * * * File: c_interface.c * * comments: c_interface primitives definition * * * * Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ * Revision 1.122 2008/08/01 21:44:24 vsc * swi compatibility support * * Revision 1.121 2008/07/24 16:02:00 vsc * improve C-interface and SWI comptaibility a bit. * * Revision 1.120 2008/07/11 17:02:07 vsc * fixes by Bart and Tom: mostly libraries but nasty one in indexing * compilation. * * Revision 1.119 2008/06/17 13:37:48 vsc * fix c_interface not to crash when people try to recover slots that are * not there. * fix try_logical and friends to handle case where predicate has arity 0. * * Revision 1.118 2008/06/04 14:47:18 vsc * make sure we do trim_trail whenever we mess with B! * * Revision 1.117 2008/06/04 13:58:36 vsc * more fixes to C-interface * * Revision 1.116 2008/04/28 23:02:32 vsc * fix bug in current_predicate/2 * fix bug in c_interface. * * Revision 1.115 2008/04/11 16:30:27 ricroc * *** empty log message *** * * Revision 1.114 2008/04/04 13:35:41 vsc * fix duplicate dependency frame at entry * * Revision 1.113 2008/04/04 09:10:02 vsc * restore was restoring twice * * Revision 1.112 2008/04/03 13:26:38 vsc * protect signal handling with locks for threaded version. * fix close/1 entry in manual (obs from Nicos). * fix -f option in chr Makefile. * * Revision 1.111 2008/04/02 21:44:07 vsc * threaded version should ignore saved states (for now). * * Revision 1.110 2008/04/02 17:37:06 vsc * handle out of memory error at thread creation (obs from Paulo Moura). * * Revision 1.109 2008/04/01 15:31:41 vsc * more saved state fixes * * Revision 1.108 2008/03/22 23:35:00 vsc * fix bug in all_calls * * Revision 1.107 2008/03/13 18:41:50 vsc * -q flag * * Revision 1.106 2008/02/12 17:03:50 vsc * SWI-portability changes * * Revision 1.105 2008/01/28 10:42:19 vsc * fix BOM trouble * * Revision 1.104 2007/12/05 12:17:23 vsc * improve JT * fix graph compatibility with SICStus * re-export declaration. * * Revision 1.103 2007/11/16 14:58:40 vsc * implement sophisticated operations with matrices. * * Revision 1.102 2007/11/01 20:50:31 vsc * fix YAP_LeaveGoal (again) * * Revision 1.101 2007/10/29 22:48:54 vsc * small fixes * * Revision 1.100 2007/10/28 00:54:09 vsc * new version of viterbi implementation * fix all:atvars reporting bad info * fix bad S info in x86_64 * * Revision 1.99 2007/10/16 18:57:17 vsc * get rid of debug statement. * * Revision 1.98 2007/10/15 23:48:46 vsc * unset var * * Revision 1.97 2007/10/05 18:24:30 vsc * fix garbage collector and fix LeaveGoal * * Revision 1.96 2007/09/04 10:34:54 vsc * Improve SWI interface emulation. * * Revision 1.95 2007/06/04 12:28:01 vsc * interface speedups * bad error message in X is foo>>2. * * Revision 1.94 2007/05/15 11:33:51 vsc * fix min list * * Revision 1.93 2007/05/14 16:44:11 vsc * improve external interface * * Revision 1.92 2007/04/18 23:01:16 vsc * fix deadlock when trying to create a module with the same name as a * predicate (for now, just don't lock modules). obs Paulo Moura. * * Revision 1.91 2007/03/30 16:47:22 vsc * fix gmpless blob handling * * Revision 1.90 2007/03/22 11:12:20 vsc * make sure that YAP_Restart does not restart a failed goal. * * Revision 1.89 2007/01/28 14:26:36 vsc * WIN32 support * * Revision 1.88 2007/01/08 08:27:19 vsc * fix restore (Trevor) * make indexing a bit faster on IDB * * Revision 1.87 2006/12/13 16:10:14 vsc * several debugger and CLP(BN) improvements. * * Revision 1.86 2006/11/27 17:42:02 vsc * support for UNICODE, and other bug fixes. * * Revision 1.85 2006/05/16 18:37:30 vsc * WIN32 fixes * compiler bug fixes * extend interface * * Revision 1.84 2006/03/09 15:52:04 tiagosoares * CUT_C and MYDDAS support for 64 bits architectures * * Revision 1.83 2006/02/08 17:29:54 tiagosoares * MYDDAS: Myddas Top Level for MySQL and Datalog * * Revision 1.82 2006/01/18 15:34:53 vsc * avoid sideffects from MkBigInt * * Revision 1.81 2006/01/16 02:57:51 vsc * fix bug with very large integers * fix bug where indexing code was looking at code after a cut. * * Revision 1.80 2006/01/02 03:35:44 vsc * fix interface and docs * * Revision 1.79 2006/01/02 02:25:44 vsc * cannot release space from external GMPs. * * Revision 1.78 2006/01/02 02:16:18 vsc * support new interface between YAP and GMP, so that we don't rely on our own * allocation routines. * Several big fixes. * * Revision 1.77 2005/11/18 18:48:51 tiagosoares * support for executing c code when a cut occurs * * Revision 1.76 2005/11/03 18:49:26 vsc * fix bignum conversion * * Revision 1.75 2005/10/28 17:38:49 vsc * sveral updates * * Revision 1.74 2005/10/21 16:07:07 vsc * fix tabling * * Revision 1.73 2005/10/18 17:04:43 vsc * 5.1: * - improvements to GC * 2 generations * generic speedups * - new scheme for attvars * - hProlog like interface also supported * - SWI compatibility layer * - extra predicates * - global variables * - moved to Prolog module * - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart * Demoen and Jan Wielemacker * - load_files/2 * * from 5.0.1 * * - WIN32 missing include files (untested) * - -L trouble (my thanks to Takeyuchi Shiramoto-san)! * - debugging of backtrable user-C preds would core dump. * - redeclaring a C-predicate as Prolog core dumps. * - badly protected YapInterface.h. * - break/0 was failing at exit. * - YAP_cut_fail and YAP_cut_succeed were different from manual. * - tracing through data-bases could core dump. * - cut could break on very large computations. * - first pass at BigNum issues (reported by Roberto). * - debugger could get go awol after fail port. * - weird message on wrong debugger option. * * Revision 1.72 2005/10/15 02:42:57 vsc * fix interface * * Revision 1.71 2005/08/17 13:35:51 vsc * YPP would leave exceptions on the system, disabling Yap-4.5.7 * message. * * Revision 1.70 2005/08/04 15:45:51 ricroc * TABLING NEW: support to limit the table space size * * Revision 1.69 2005/07/19 17:12:18 rslopes * fix for older compilers that do not support declaration of vars * in the middle of the function code. * * Revision 1.68 2005/05/31 00:23:47 ricroc * remove abort_yapor function * * Revision 1.67 2005/04/10 04:35:19 vsc * AllocMemoryFromYap should now handle large requests the right way. * * Revision 1.66 2005/04/10 04:01:10 vsc * bug fixes, I hope! * * Revision 1.65 2005/03/15 18:29:23 vsc * fix GPL * fix idb: stuff in coroutines. * * Revision 1.64 2005/03/13 06:26:10 vsc * fix excessive pruning in meta-calls * fix Term->int breakage in compiler * improve JPL (at least it does something now for amd64). * * Revision 1.63 2005/03/04 20:30:10 ricroc * bug fixes for YapTab support * * Revision 1.62 2005/03/02 18:35:44 vsc * try to make initialisation process more robust * try to make name more robust (in case Lookup new atom fails) * * Revision 1.61 2005/03/01 22:25:08 vsc * fix pruning bug * make DL_MALLOC less enthusiastic about walking through buckets. * * Revision 1.60 2005/02/08 18:04:47 vsc * library_directory may not be deterministic (usually it isn't). * * Revision 1.59 2004/12/08 00:56:35 vsc * missing ; * * Revision 1.58 2004/11/19 22:08:41 vsc * replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate. * * Revision 1.57 2004/11/18 22:32:31 vsc * fix situation where we might assume nonextsing double initialisation of C predicates (use * Hidden Pred Flag). * $host_type was double initialised. * * Revision 1.56 2004/10/31 02:18:03 vsc * fix bug in handling Yap heap overflow while adding new clause. * * Revision 1.55 2004/10/28 20:12:20 vsc * Use Doug Lea's malloc as an alternative to YAP's standard malloc * don't use TR directly in scanner/parser, this avoids trouble with ^C while * consulting large files. * pass gcc -mno-cygwin to library compilation in cygwin environment (cygwin should * compile out of the box now). * * Revision 1.54 2004/10/06 16:55:46 vsc * change configure to support big mem configs * get rid of extra globals * fix trouble with multifile preds * * Revision 1.53 2004/08/11 16:14:51 vsc * whole lot of fixes: * - memory leak in indexing * - memory management in WIN32 now supports holes * - extend Yap interface, more support for SWI-Interface * - new predicate mktime in system * - buffer console I/O in WIN32 * * Revision 1.52 2004/07/23 03:37:16 vsc * fix heap overflow in YAP_LookupAtom * * Revision 1.51 2004/07/22 21:32:20 vsc * debugger fixes * initial support for JPL * bad calls to garbage collector and gc * debugger fixes * * Revision 1.50 2004/06/29 19:04:41 vsc * fix multithreaded version * include new version of Ricardo's profiler * new predicat atomic_concat * allow multithreaded-debugging * small fixes * * Revision 1.49 2004/06/09 03:32:02 vsc * fix bugs * * Revision 1.48 2004/06/05 03:36:59 vsc * coroutining is now a part of attvars. * some more fixes. * * Revision 1.47 2004/05/17 21:42:08 vsc * misc fixes * * Revision 1.46 2004/05/14 17:56:45 vsc * Yap_WriteBuffer * * Revision 1.45 2004/05/14 17:11:30 vsc * support BigNums in interface * * Revision 1.44 2004/05/14 16:33:44 vsc * add Yap_ReadBuffer * * * * *************************************************************************/ #define Bool int #define flt double #define C_INTERFACE #include #include "Yap.h" #include "clause.h" #include "yapio.h" #include "attvar.h" #include "SWI-Stream.h" #if HAVE_STDARG_H #include #endif #if HAVE_STDINT_H #include #endif #if HAVE_STRING_H #include #endif #if _MSC_VER || defined(__MINGW32__) #include #endif #include "iopreds.h" #include "yap_structs.h" #ifdef TABLING #include "tab.macros.h" #endif /* TABLING */ #ifdef YAPOR #include "or.macros.h" #endif /* YAPOR */ #include "threads.h" #ifdef CUT_C #include "cut_c.h" #endif /* CUT_C */ #if HAVE_MALLOC_H #include #endif #if !HAVE_STRNCPY #define strncpy(X,Y,Z) strcpy(X,Y) #endif #if !HAVE_STRNCAT #define strncat(X,Y,Z) strcat(X,Y) #endif #if defined(_MSC_VER) && defined(YAP_EXPORTS) #define X_API __declspec(dllexport) #else #define X_API #endif X_API Term STD_PROTO(YAP_A,(int)); X_API Term STD_PROTO(YAP_Deref,(Term)); 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_IsLongIntTerm,(Term)); X_API Bool STD_PROTO(YAP_IsBigNumTerm,(Term)); X_API Bool STD_PROTO(YAP_IsRationalTerm,(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 Bool STD_PROTO(YAP_IsExternalDataInStackTerm,(Term)); X_API Bool STD_PROTO(YAP_IsOpaqueObjectTerm,(Term, int)); X_API Term STD_PROTO(YAP_MkIntTerm,(Int)); X_API Term STD_PROTO(YAP_MkBigNumTerm,(void *)); X_API Term STD_PROTO(YAP_MkRationalTerm,(void *)); X_API Int STD_PROTO(YAP_IntOfTerm,(Term)); X_API void STD_PROTO(YAP_BigNumOfTerm,(Term, void *)); X_API void STD_PROTO(YAP_RationalOfTerm,(Term, void *)); 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_LookupWideAtom,(wchar_t *)); X_API size_t STD_PROTO(YAP_AtomNameLength,(Atom)); X_API Atom STD_PROTO(YAP_FullLookupAtom,(char *)); X_API int STD_PROTO(YAP_IsWideAtom,(Atom)); X_API char *STD_PROTO(YAP_AtomName,(Atom)); X_API wchar_t *STD_PROTO(YAP_WideAtomName,(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 int STD_PROTO(YAP_SkipList,(Term *, Term **)); X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,UInt,Term *)); X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,UInt)); X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term)); X_API Term STD_PROTO(YAP_ArgOfTerm,(Int,Term)); X_API Term *STD_PROTO(YAP_ArgsOfTerm,(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 void STD_PROTO(YAP_cut_up,(void)); 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 PredEntry *STD_PROTO(YAP_FunctorToPred,(Functor)); X_API PredEntry *STD_PROTO(YAP_AtomToPred,(Atom)); X_API Int STD_PROTO(YAP_CallProlog,(Term)); X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int)); X_API void *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,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_ReadBuffer, (char *,Term *)); X_API Term STD_PROTO(YAP_BufferToString, (char *)); X_API Term STD_PROTO(YAP_NBufferToString, (char *, size_t)); X_API Term STD_PROTO(YAP_WideBufferToString, (wchar_t *)); X_API Term STD_PROTO(YAP_NWideBufferToString, (wchar_t *, size_t)); X_API Term STD_PROTO(YAP_BufferToAtomList, (char *)); X_API Term STD_PROTO(YAP_NBufferToAtomList, (char *,size_t)); X_API Term STD_PROTO(YAP_WideBufferToAtomList, (wchar_t *)); X_API Term STD_PROTO(YAP_NWideBufferToAtomList, (wchar_t *, size_t)); X_API Term STD_PROTO(YAP_NWideBufferToAtomDiffList, (wchar_t *, Term, size_t)); X_API Term STD_PROTO(YAP_BufferToDiffList, (char *, Term)); X_API Term STD_PROTO(YAP_NBufferToDiffList, (char *, Term, size_t)); X_API Term STD_PROTO(YAP_WideBufferToDiffList, (wchar_t *, Term)); X_API Term STD_PROTO(YAP_NWideBufferToDiffList, (wchar_t *, Term, size_t)); X_API void STD_PROTO(YAP_Error,(int, Term, char *, ...)); X_API Term STD_PROTO(YAP_RunGoal,(Term)); X_API Term STD_PROTO(YAP_RunGoalOnce,(Term)); X_API int STD_PROTO(YAP_RestartGoal,(void)); X_API int STD_PROTO(YAP_ShutdownGoal,(int)); X_API int STD_PROTO(YAP_EnterGoal,(PredEntry *, Term *, YAP_dogoalinfo *)); X_API int STD_PROTO(YAP_RetryGoal,(YAP_dogoalinfo *)); X_API int STD_PROTO(YAP_LeaveGoal,(int, YAP_dogoalinfo *)); X_API int STD_PROTO(YAP_GoalHasException,(Term *)); X_API void STD_PROTO(YAP_ClearExceptions,(void)); X_API int STD_PROTO(YAP_ContinueGoal,(void)); X_API void STD_PROTO(YAP_PruneGoal,(void)); X_API IOSTREAM *STD_PROTO(YAP_TermToStream,(Term)); X_API IOSTREAM *STD_PROTO(YAP_InitConsult,(int, char *)); X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *)); X_API Term STD_PROTO(YAP_Read, (IOSTREAM *)); X_API void STD_PROTO(YAP_Write, (Term, IOSTREAM *, int)); X_API Term STD_PROTO(YAP_CopyTerm, (Term)); X_API Term STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned 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_CompareTerms, (Term,Term)); 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 void STD_PROTO(YAP_FlushAllStreams,(void)); X_API Int STD_PROTO(YAP_CurrentSlot,(void)); X_API Int STD_PROTO(YAP_NewSlots,(int)); X_API Int STD_PROTO(YAP_InitSlot,(Term)); X_API Term STD_PROTO(YAP_GetFromSlot,(Int)); X_API Term *STD_PROTO(YAP_AddressFromSlot,(Int)); X_API Term *STD_PROTO(YAP_AddressOfTermInSlot,(Int)); X_API void STD_PROTO(YAP_PutInSlot,(Int, Term)); X_API int STD_PROTO(YAP_RecoverSlots,(int)); X_API Int STD_PROTO(YAP_ArgsToSlots,(int)); X_API void STD_PROTO(YAP_SlotsToArgs,(int, Int)); X_API void STD_PROTO(YAP_Throw,(Term)); X_API void STD_PROTO(YAP_AsyncThrow,(Term)); X_API void STD_PROTO(YAP_Halt,(int)); X_API Term *STD_PROTO(YAP_TopOfLocalStack,(void)); X_API void *STD_PROTO(YAP_Predicate,(Atom,UInt,Term)); X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,UInt *,Term *)); X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,UInt)); X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,UInt,unsigned int)); X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,UInt,Term)); #ifdef CUT_C X_API void STD_PROTO(YAP_UserBackCutCPredicate,(char *,CPredicate,CPredicate,CPredicate,UInt,unsigned int)); X_API void *STD_PROTO(YAP_ExtraSpaceCut,(void)); #endif X_API Term STD_PROTO(YAP_SetCurrentModule,(Term)); X_API Term STD_PROTO(YAP_CurrentModule,(void)); X_API Term STD_PROTO(YAP_CreateModule,(Atom)); X_API Term STD_PROTO(YAP_StripModule,(Term, Term *)); X_API int STD_PROTO(YAP_ThreadSelf,(void)); X_API int STD_PROTO(YAP_ThreadCreateEngine,(struct thread_attr_struct *)); X_API int STD_PROTO(YAP_ThreadAttachEngine,(int)); X_API int STD_PROTO(YAP_ThreadDetachEngine,(int)); X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int)); X_API Term STD_PROTO(YAP_MkBlobTerm,(unsigned int)); X_API void *STD_PROTO(YAP_BlobOfTerm,(Term)); X_API Term STD_PROTO(YAP_TermNil,(void)); X_API int STD_PROTO(YAP_AtomGetHold,(Atom)); X_API int STD_PROTO(YAP_AtomReleaseHold,(Atom)); X_API Agc_hook STD_PROTO(YAP_AGCRegisterHook,(Agc_hook)); X_API int STD_PROTO(YAP_HaltRegisterHook,(HaltHookFunc, void *)); X_API char *STD_PROTO(YAP_cwd,(void)); X_API Term STD_PROTO(YAP_OpenList,(int)); X_API Term STD_PROTO(YAP_ExtendList,(Term, Term)); X_API int STD_PROTO(YAP_CloseList,(Term, Term)); X_API int STD_PROTO(YAP_IsAttVar,(Term)); X_API Term STD_PROTO(YAP_AttsOfVar,(Term)); X_API int STD_PROTO(YAP_FileNoFromStream,(Term)); X_API void *STD_PROTO(YAP_FileDescriptorFromStream,(Term)); X_API void *STD_PROTO(YAP_Record,(Term)); X_API Term STD_PROTO(YAP_Recorded,(void *)); X_API int STD_PROTO(YAP_Erase,(void *)); X_API int STD_PROTO(YAP_Variant,(Term, Term)); X_API int STD_PROTO(YAP_ExactlyEqual,(Term, Term)); X_API Int STD_PROTO(YAP_TermHash,(Term, Int, Int, int)); X_API void STD_PROTO(YAP_signal,(int)); X_API int STD_PROTO(YAP_SetYAPFlag,(yap_flag_t, int)); X_API Int STD_PROTO(YAP_VarSlotToNumber,(Int)); X_API Term STD_PROTO(YAP_ModuleUser,(void)); X_API Int STD_PROTO(YAP_NumberOfClausesForPredicate,(PredEntry *)); X_API int STD_PROTO(YAP_MaxOpPriority,(Atom, Term)); X_API int STD_PROTO(YAP_OpInfo,(Atom, Term, int, int *, int *)); X_API Term STD_PROTO(YAP_AllocExternalDataInStack,(size_t)); X_API void *STD_PROTO(YAP_ExternalDataInStackFromTerm,(Term)); X_API int STD_PROTO(YAP_NewOpaqueType,(void *)); X_API Term STD_PROTO(YAP_NewOpaqueObject,(int, size_t)); X_API void *STD_PROTO(YAP_OpaqueObjectFromTerm,(Term)); static int dogc(void) { CACHE_REGS UInt arity; if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) { arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE; } else { arity = 0; } if (!Yap_gc(arity, ENV, CP)) { return FALSE; } return TRUE; } static int doexpand(UInt sz) { CACHE_REGS UInt arity; if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) { arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE; } else { arity = 0; } if (!Yap_gcl(sz, arity, ENV, gc_P(P,CP))) { return FALSE; } return TRUE; } X_API Term YAP_A(int i) { CACHE_REGS return(Deref(XREGS[i])); } X_API Term YAP_Deref(Term t) { return(Deref(t)); } X_API Bool YAP_IsIntTerm(Term t) { return IsIntegerTerm(t); } X_API Bool YAP_IsLongIntTerm(Term t) { return IsLongIntTerm(t); } X_API Bool YAP_IsBigNumTerm(Term t) { #if USE_GMP CELL *pt; if (IsVarTerm(t)) return FALSE; if (!IsBigIntTerm(t)) return FALSE; pt = RepAppl(t); return pt[1] == BIG_INT; #else return FALSE; #endif } X_API Bool YAP_IsRationalTerm(Term t) { #if USE_GMP CELL *pt; if (IsVarTerm(t)) return FALSE; if (!IsBigIntTerm(t)) return FALSE; pt = RepAppl(t); return pt[1] == BIG_RATIONAL; #else return FALSE; #endif } X_API Bool YAP_IsVarTerm(Term t) { return (IsVarTerm(t)); } X_API Bool YAP_IsNonVarTerm(Term t) { return (IsNonVarTerm(t)); } X_API Bool YAP_IsFloatTerm(Term t) { return (IsFloatTerm(t)); } X_API Bool YAP_IsDbRefTerm(Term t) { return (IsDBRefTerm(t)); } X_API Bool YAP_IsAtomTerm(Term t) { return (IsAtomTerm(t)); } X_API Bool YAP_IsPairTerm(Term t) { return (IsPairTerm(t)); } X_API Bool YAP_IsApplTerm(Term t) { return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))); } X_API Term YAP_MkIntTerm(Int n) { Term I; BACKUP_H(); I = MkIntegerTerm(n); RECOVER_H(); return I; } X_API Int YAP_IntOfTerm(Term t) { if (!IsApplTerm(t)) return IntOfTerm(t); else { return LongIntOfTerm(t); } } X_API Term YAP_MkBigNumTerm(void *big) { #if USE_GMP Term I; BACKUP_H(); I = Yap_MkBigIntTerm((MP_INT *)big); RECOVER_H(); return I; #else return TermNil; #endif /* USE_GMP */ } X_API void YAP_BigNumOfTerm(Term t, void *b) { #if USE_GMP MP_INT *bz = (MP_INT *)b; if (IsVarTerm(t)) return; if (!IsBigIntTerm(t)) return; mpz_set(bz,Yap_BigIntOfTerm(t)); #endif /* USE_GMP */ } X_API Term YAP_MkRationalTerm(void *big) { #if USE_GMP Term I; BACKUP_H(); I = Yap_MkBigRatTerm((MP_RAT *)big); RECOVER_H(); return I; #else return TermNil; #endif /* USE_GMP */ } X_API void YAP_RationalOfTerm(Term t, void *b) { #if USE_GMP MP_RAT *br = (MP_RAT *)b; if (IsVarTerm(t)) return; if (!IsBigIntTerm(t)) return; mpq_set(br,Yap_BigRatOfTerm(t)); #endif /* USE_GMP */ } X_API Term YAP_MkBlobTerm(unsigned int sz) { CACHE_REGS Term I; MP_INT *dst; BACKUP_H(); while (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) { if (!doexpand((sz+sizeof(MP_INT)/sizeof(CELL)+2)*sizeof(CELL))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", LOCAL_ErrorMessage); return TermNil; } } I = AbsAppl(H); H[0] = (CELL)FunctorBigInt; H[1] = ARRAY_INT; dst = (MP_INT *)(H+2); dst->_mp_size = 0L; dst->_mp_alloc = sz; H += (2+sizeof(MP_INT)/sizeof(CELL)); H[sz] = EndSpecials; H += sz+1; RECOVER_H(); return I; } X_API void * YAP_BlobOfTerm(Term t) { MP_INT *src; if (IsVarTerm(t)) return NULL; if (!IsBigIntTerm(t)) return NULL; src = (MP_INT *)(RepAppl(t)+2); return (void *)(src+1); } X_API Term YAP_MkFloatTerm(double n) { Term t; BACKUP_H(); t = MkFloatTerm(n); RECOVER_H(); return t; } X_API flt YAP_FloatOfTerm(Term t) { return (FloatOfTerm(t)); } X_API Term YAP_MkAtomTerm(Atom n) { Term t; t = MkAtomTerm(n); return t; } X_API Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); } X_API int YAP_IsWideAtom(Atom a) { return IsWideAtom(a); } X_API char * YAP_AtomName(Atom a) { char *o; o = AtomName(a); return(o); } X_API wchar_t * YAP_WideAtomName(Atom a) { return RepAtom(a)->WStrOfAE; } X_API Atom YAP_LookupAtom(char *c) { CACHE_REGS Atom a; while (TRUE) { a = Yap_LookupAtom(c); if (a == NIL || (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL)) { if (!Yap_growheap(FALSE, 0, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } else { return a; } } } X_API Atom YAP_LookupWideAtom(wchar_t *c) { CACHE_REGS Atom a; while (TRUE) { a = Yap_LookupWideAtom(c); if (a == NIL || (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL)) { if (!Yap_growheap(FALSE, 0, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } else { return a; } } } X_API Atom YAP_FullLookupAtom(char *c) { CACHE_REGS Atom at; while (TRUE) { at = Yap_FullLookupAtom(c); if (at == NIL || (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL)) { if (!Yap_growheap(FALSE, 0, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } else { return at; } } } X_API size_t YAP_AtomNameLength(Atom at) { if (IsBlob(at)) { return RepAtom(at)->rep.blob->length; } if (IsWideAtom(at)) { wchar_t *c = RepAtom(at)->WStrOfAE; return wcslen(c); } else { char *c = RepAtom(at)->StrOfAE; return strlen(c); } } X_API Term YAP_MkVarTerm(void) { CACHE_REGS CELL t; BACKUP_H(); t = MkVarTerm(); RECOVER_H(); return t; } X_API Term YAP_MkPairTerm(Term t1, Term t2) { CACHE_REGS Term t; BACKUP_H(); if (H > ASP-1024) { Int sl1 = Yap_InitSlot(t1 PASS_REGS); Int sl2 = Yap_InitSlot(t2 PASS_REGS); if (!dogc()) { RECOVER_H(); return TermNil; } t1 = Yap_GetFromSlot(sl1 PASS_REGS); t2 = Yap_GetFromSlot(sl2 PASS_REGS); Yap_RecoverSlots(2 PASS_REGS); } t = MkPairTerm(t1, t2); RECOVER_H(); return t; } X_API Term YAP_MkNewPairTerm() { CACHE_REGS Term t; BACKUP_H(); if (H > ASP-1024) t = TermNil; else t = Yap_MkNewPairTerm(); RECOVER_H(); return t; } X_API Term YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); } X_API Term YAP_TailOfTerm(Term t) { return (TailOfTerm(t)); } X_API int YAP_SkipList(Term *l, Term **tailp) { Int length = 0; Term *s; /* slow */ Term v; /* temporary */ v = Derefa(l); s = l; if ( IsPairTerm(*l) ) { intptr_t power = 1, lam = 0; do { if ( power == lam ) { s = l; power *= 2; lam = 0; } lam++; length++; l = RepPair(*l)+1; v = Derefa(l); } while ( *l != *s && IsPairTerm(*l) ); } *tailp = l; return length; } X_API Term YAP_MkApplTerm(Functor f,UInt arity, Term args[]) { CACHE_REGS Term t; BACKUP_H(); if (H+arity > ASP-1024) t = TermNil; else t = Yap_MkApplTerm(f, arity, args); RECOVER_H(); return t; } X_API Term YAP_MkNewApplTerm(Functor f,UInt arity) { CACHE_REGS Term t; BACKUP_H(); if (H+arity > ASP-1024) t = TermNil; else t = Yap_MkNewApplTerm(f, arity); RECOVER_H(); return t; } X_API Functor YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); } X_API Term YAP_ArgOfTerm(Int n, Term t) { return (ArgOfTerm(n, t)); } X_API Term * YAP_ArgsOfTerm(Term t) { if (IsApplTerm(t)) return RepAppl(t)+1; else if (IsPairTerm(t)) return RepPair(t); return NULL; } X_API Functor YAP_MkFunctor(Atom a, Int n) { return (Yap_MkFunctor(a, n)); } X_API Atom YAP_NameOfFunctor(Functor f) { return (NameOfFunctor(f)); } X_API Int YAP_ArityOfFunctor(Functor f) { return (ArityOfFunctor(f)); } #ifdef CUT_C X_API void * YAP_ExtraSpaceCut(void) { CACHE_REGS void *ptr; BACKUP_B(); ptr = (void *)(((CELL *)(Yap_REGS.CUT_C_TOP))-(((yamop *)Yap_REGS.CUT_C_TOP->try_userc_cut_yamop)->u.OtapFs.extra)); RECOVER_B(); return(ptr); } #endif /*CUT_C*/ X_API void * YAP_ExtraSpace(void) { CACHE_REGS void *ptr; BACKUP_B(); BACKUP_H(); /* find a pointer to extra space allocable */ ptr = (void *)((CELL *)(B+1)+P->u.OtapFs.s); B->cp_h = H; RECOVER_H(); RECOVER_B(); return(ptr); } X_API void YAP_cut_up(void) { CACHE_REGS BACKUP_B(); #ifdef CUT_C { while (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } } #endif /* CUT_C */ /* This is complicated: make sure we can restore the ASP pointer back to where cut_up called it. Slots depend on it. */ if (ENV > B->cp_env) { ASP = B->cp_env; Yap_PopSlots( PASS_REGS1 ); } #ifdef YAPOR { choiceptr cut_pt; cut_pt = B->cp_b; /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } CUT_prune_to(cut_pt); Yap_TrimTrail(); B = cut_pt; } #else /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } Yap_TrimTrail(); B = B->cp_b; /* cut_fail */ #endif HB = B->cp_h; /* cut_fail */ RECOVER_B(); } X_API Int YAP_Unify(Term t1, Term t2) { Int out; BACKUP_MACHINE_REGS(); out = Yap_unify(t1, t2); RECOVER_MACHINE_REGS(); return out; } /* == */ X_API int YAP_ExactlyEqual(Term t1, Term t2) { int out; BACKUP_MACHINE_REGS(); out = Yap_eq(t1, t2); RECOVER_MACHINE_REGS(); return out; } /* =@= */ X_API int YAP_Variant(Term t1, Term t2) { int out; BACKUP_MACHINE_REGS(); out = Yap_Variant(Deref(t1), Deref(t2)); RECOVER_MACHINE_REGS(); return out; } /* =@= */ X_API Int YAP_TermHash(Term t, Int sz, Int depth, int variant) { Int out; BACKUP_MACHINE_REGS(); out = Yap_TermHash(t, sz, depth, variant); RECOVER_MACHINE_REGS(); return out; } X_API Int YAP_CurrentSlot(void) { CACHE_REGS return Yap_CurrentSlot( PASS_REGS1 ); } X_API Int YAP_NewSlots(int n) { CACHE_REGS return Yap_NewSlots(n PASS_REGS); } X_API Int YAP_InitSlot(Term t) { CACHE_REGS return Yap_InitSlot(t PASS_REGS); } X_API int YAP_RecoverSlots(int n) { CACHE_REGS return Yap_RecoverSlots(n PASS_REGS); } X_API Term YAP_GetFromSlot(Int slot) { CACHE_REGS return Yap_GetFromSlot(slot PASS_REGS); } X_API Term * YAP_AddressFromSlot(Int slot) { CACHE_REGS return Yap_AddressFromSlot(slot PASS_REGS); } X_API Term * YAP_AddressOfTermInSlot(Int slot) { CACHE_REGS Term *b = Yap_AddressFromSlot(slot PASS_REGS); Term a = *b; restart: if (!IsVarTerm(a)) { return(b); } else if (a == (CELL)b) { return(b); } else { b = (CELL *)a; a = *b; goto restart; } } X_API void YAP_PutInSlot(Int slot, Term t) { CACHE_REGS Yap_PutInSlot(slot, t PASS_REGS); } typedef enum { FRG_FIRST_CALL = 0, /* Initial call */ FRG_CUTTED = 1, /* Context was cutted */ FRG_REDO = 2 /* Normal redo */ } frg_code; typedef struct foreign_context { int * context; /* context value */ frg_code control; /* FRG_* action */ struct PL_local_data *engine; /* invoking engine */ } scontext ; typedef Int (*CPredicate0)(void); typedef Int (*CPredicate1)(Int); typedef Int (*CPredicate2)(Int,Int); typedef Int (*CPredicate3)(Int,Int,Int); typedef Int (*CPredicate4)(Int,Int,Int,Int); typedef Int (*CPredicate5)(Int,Int,Int,Int,Int); typedef Int (*CPredicate6)(Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate7)(Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicateV)(Int,Int,struct foreign_context *); static Int execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS) { switch (pe->ArityOfPE) { case 0: { CPredicate0 code0 = (CPredicate0)exec_code; return ((code0)()); } case 1: { CPredicate1 code1 = (CPredicate1)exec_code; return ((code1)(Yap_InitSlot(Deref(ARG1) PASS_REGS))); } case 2: { CPredicate2 code2 = (CPredicate2)exec_code; return ((code2)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS))); } case 3: { CPredicate3 code3 = (CPredicate3)exec_code; return ((code3)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS))); } case 4: { CPredicate4 code4 = (CPredicate4)exec_code; return ((code4)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS))); } case 5: { CPredicate5 code5 = (CPredicate5)exec_code; return ((code5)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS), Yap_InitSlot(Deref(ARG5) PASS_REGS))); } case 6: { CPredicate6 code6 = (CPredicate6)exec_code; return ((code6)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS), Yap_InitSlot(Deref(ARG5) PASS_REGS), Yap_InitSlot(Deref(ARG6) PASS_REGS))); } case 7: { CPredicate7 code7 = (CPredicate7)exec_code; return ((code7)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS), Yap_InitSlot(Deref(ARG5) PASS_REGS), Yap_InitSlot(Deref(ARG6) PASS_REGS), Yap_InitSlot(Deref(ARG7) PASS_REGS))); } case 8: { CPredicate8 code8 = (CPredicate8)exec_code; return ((code8)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS), Yap_InitSlot(Deref(ARG5) PASS_REGS), Yap_InitSlot(Deref(ARG6) PASS_REGS), Yap_InitSlot(Deref(ARG7) PASS_REGS), Yap_InitSlot(Deref(ARG8) PASS_REGS))); } case 9: { CPredicate9 code9 = (CPredicate9)exec_code; return ((code9)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS), Yap_InitSlot(Deref(ARG5) PASS_REGS), Yap_InitSlot(Deref(ARG6) PASS_REGS), Yap_InitSlot(Deref(ARG7) PASS_REGS), Yap_InitSlot(Deref(ARG8) PASS_REGS), Yap_InitSlot(Deref(ARG9) PASS_REGS))); } case 10: { CPredicate10 code10 = (CPredicate10)exec_code; return ((code10)(Yap_InitSlot(Deref(ARG1) PASS_REGS), Yap_InitSlot(Deref(ARG2) PASS_REGS), Yap_InitSlot(Deref(ARG3) PASS_REGS), Yap_InitSlot(Deref(ARG4) PASS_REGS), Yap_InitSlot(Deref(ARG5) PASS_REGS), Yap_InitSlot(Deref(ARG6) PASS_REGS), Yap_InitSlot(Deref(ARG7) PASS_REGS), Yap_InitSlot(Deref(ARG8) PASS_REGS), Yap_InitSlot(Deref(ARG9) PASS_REGS), Yap_InitSlot(Deref(ARG10) PASS_REGS))); } default: return(FALSE); } } typedef Int (*CBPredicate)(struct foreign_context *); typedef Int (*CBPredicate1)(Int,struct foreign_context *); typedef Int (*CBPredicate2)(Int,Int,struct foreign_context *); typedef Int (*CBPredicate3)(Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate4)(Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate5)(Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate6)(Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate7)(Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef Int (*CBPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); static Int execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx USES_REGS) { switch (pe->ArityOfPE) { case 0: { CBPredicate code0 = (CBPredicate)exec_code; return ((code0)(ctx)); } case 1: { CBPredicate1 code1 = (CBPredicate1)exec_code; return ((code1)(&B->cp_a1-LCL0, ctx)); } case 2: { CBPredicate2 code2 = (CBPredicate2)exec_code; return ((code2)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, ctx)); } case 3: { CBPredicate3 code3 = (CBPredicate3)exec_code; return ((code3)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, ctx)); } case 4: { CBPredicate4 code4 = (CBPredicate4)exec_code; return ((code4)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, ctx)); } case 5: { CBPredicate5 code5 = (CBPredicate5)exec_code; return ((code5)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, &B->cp_a5-LCL0, ctx)); } case 6: { CBPredicate6 code6 = (CBPredicate6)exec_code; return ((code6)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, &B->cp_a5-LCL0, &B->cp_a6-LCL0, ctx)); } case 7: { CBPredicate7 code7 = (CBPredicate7)exec_code; return ((code7)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, &B->cp_a5-LCL0, &B->cp_a6-LCL0, &B->cp_a7-LCL0, ctx)); } case 8: { CBPredicate8 code8 = (CBPredicate8)exec_code; return ((code8)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, &B->cp_a5-LCL0, &B->cp_a6-LCL0, &B->cp_a7-LCL0, &B->cp_a8-LCL0, ctx)); } case 9: { CBPredicate9 code9 = (CBPredicate9)exec_code; return ((code9)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, &B->cp_a5-LCL0, &B->cp_a6-LCL0, &B->cp_a7-LCL0, &B->cp_a8-LCL0, &B->cp_a9-LCL0, ctx)); } case 10: { CBPredicate10 code10 = (CBPredicate10)exec_code; return ((code10)(&B->cp_a1-LCL0, &B->cp_a2-LCL0, &B->cp_a3-LCL0, &B->cp_a4-LCL0, &B->cp_a5-LCL0, &B->cp_a6-LCL0, &B->cp_a7-LCL0, &B->cp_a8-LCL0, &B->cp_a9-LCL0, &B->cp_a10-LCL0, ctx)); } default: return(FALSE); } } Int YAP_Execute(PredEntry *pe, CPredicate exec_code) { CACHE_REGS Int ret; if (pe->PredFlags & SWIEnvPredFlag) { CPredicateV codev = (CPredicateV)exec_code; struct foreign_context ctx; UInt i; Int sl = 0; ctx.engine = NULL; for (i=pe->ArityOfPE; i > 0; i--) { sl = Yap_InitSlot(XREGS[i] PASS_REGS); } PP = pe; ret = ((codev)(sl,0,&ctx)); } else if (pe->PredFlags & CArgsPredFlag) { PP = pe; ret = execute_cargs(pe, exec_code PASS_REGS); } else { PP = pe; ret = (exec_code)( PASS_REGS1 ); } PP = NULL; if (!ret) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { Yap_JumpToEnv(t); return FALSE; } } return ret; } #define FRG_REDO_MASK 0x00000003L #define FRG_REDO_BITS 2 #define REDO_INT 0x02 /* Returned an integer */ #define REDO_PTR 0x03 /* returned a pointer */ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) { CACHE_REGS if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) { Int val; CPredicateV codev = (CPredicateV)exec_code; struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); struct open_query_struct *oexec = LOCAL_execution; extern void PL_close_foreign_frame(struct open_query_struct *); PP = pe; ctx->control = FRG_FIRST_CALL; ctx->engine = NULL; //(PL_local_data *)Yap_regp; ctx->context = NULL; if (pe->PredFlags & CArgsPredFlag) { val = execute_cargs_back(pe, exec_code, ctx PASS_REGS); } else { val = ((codev)(B->cp_args-LCL0,0,ctx)); } /* make sure we clean up the frames left by the user */ while (LOCAL_execution != oexec) PL_close_foreign_frame(LOCAL_execution); PP = NULL; if (val == 0) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { cut_c_pop(); B = B->cp_b; Yap_JumpToEnv(t); return FALSE; } cut_fail(); } else if (val == 1) { /* TRUE */ cut_succeed(); } else { if ((val & REDO_PTR) == REDO_PTR) ctx->context = (int *)(val & ~REDO_PTR); else ctx->context = (int *)((val & ~REDO_PTR)>>FRG_REDO_BITS); return TRUE; } } else { Int ret = (exec_code)( PASS_REGS1 ); if (!ret) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { Yap_JumpToEnv(t); return FALSE; } } return ret; } } Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top) { CACHE_REGS choiceptr oB = B; /* find out where we belong */ while (B->cp_b < (choiceptr)top) B = B->cp_b; if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) { Int val; CPredicateV codev = (CPredicateV)exec_code; struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); struct open_query_struct *oexec = LOCAL_execution; extern void PL_close_foreign_frame(struct open_query_struct *); CELL *args = B->cp_args; B = oB; PP = pe; ctx->control = FRG_CUTTED; ctx->engine = NULL; //(PL_local_data *)Yap_regp; ctx->context = NULL; if (pe->PredFlags & CArgsPredFlag) { val = execute_cargs_back(pe, exec_code, ctx PASS_REGS); } else { val = ((codev)(args-LCL0,0,ctx)); } /* make sure we clean up the frames left by the user */ while (LOCAL_execution != oexec) PL_close_foreign_frame(LOCAL_execution); PP = NULL; // B = LCL0-(CELL*)oB; if (val == 0) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { cut_c_pop(); Yap_JumpToEnv(t); return FALSE; } return FALSE; } else { /* TRUE */ return TRUE; } } else { Int ret; B = oB; ret = (exec_code)( PASS_REGS1 ); if (!ret) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { Yap_JumpToEnv(t); return FALSE; } } return ret; } } Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) { CACHE_REGS if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) { Int val; CPredicateV codev = (CPredicateV)exec_code; struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); struct open_query_struct *oexec = LOCAL_execution; extern void PL_close_foreign_frame(struct open_query_struct *); PP = pe; ctx->control = FRG_REDO; if (pe->PredFlags & CArgsPredFlag) { val = execute_cargs_back(pe, exec_code, ctx PASS_REGS); } else { val = ((codev)(B->cp_args-LCL0,0,ctx)); } /* make sure we clean up the frames left by the user */ while (LOCAL_execution != oexec) PL_close_foreign_frame(LOCAL_execution); PP = NULL; if (val == 0) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { cut_c_pop(); B = B->cp_b; Yap_JumpToEnv(t); return FALSE; } else { cut_fail(); } } else if (val == 1) { /* TRUE */ cut_succeed(); } else { if ((val & REDO_PTR) == REDO_PTR) ctx->context = (int *)(val & ~REDO_PTR); else ctx->context = (int *)((val & ~REDO_PTR)>>FRG_REDO_BITS); } return TRUE; } else { Int ret = (exec_code)( PASS_REGS1 ); if (!ret) { Term t; LOCAL_BallTerm = EX; EX = NULL; if ((t = Yap_GetException())) { Yap_JumpToEnv(t); return FALSE; } } return ret; } } X_API Int YAP_CallProlog(Term t) { CACHE_REGS Int out; Term mod = CurrentModule; BACKUP_MACHINE_REGS(); while (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) { Term tmod = ArgOfTerm(1,t); if (IsVarTerm(tmod)) return(FALSE); if (!IsAtomTerm(tmod)) return(FALSE); mod = tmod; t = ArgOfTerm(2,t); } out = Yap_execute_goal(t, 0, mod); RECOVER_MACHINE_REGS(); return(out); } X_API void * YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) { CACHE_REGS void *new_ptr; BACKUP_MACHINE_REGS(); while ((new_ptr = Yap_ReallocCodeSpace(ptr,size)) == NULL) { if (!Yap_growheap(FALSE, size, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } RECOVER_MACHINE_REGS(); return new_ptr; } X_API void * YAP_AllocSpaceFromYap(unsigned int size) { CACHE_REGS void *ptr; BACKUP_MACHINE_REGS(); while ((ptr = Yap_AllocCodeSpace(size)) == NULL) { if (!Yap_growheap(FALSE, size, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } RECOVER_MACHINE_REGS(); return ptr; } X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); } /* copy a string to a buffer */ X_API int YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { unsigned int j = 0; while (t != TermNil) { register Term Head; register Int i; Head = HeadOfTerm(t); if (IsVarTerm(Head)) { Yap_Error(INSTANTIATION_ERROR,Head,"user defined procedure"); return(FALSE); } else if (!IsIntTerm(Head)) { Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure"); return(FALSE); } i = IntOfTerm(Head); if (i < 0 || i > 255) { Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure"); return(FALSE); } buf[j++] = i; if (j > bufsize) { buf[j-1] = '\0'; return(FALSE); } t = TailOfTerm(t); if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR,t,"user defined procedure"); return(FALSE); } else if (!IsPairTerm(t) && t != TermNil) { Yap_Error(TYPE_ERROR_LIST, t, "user defined procedure"); return(FALSE); } } buf[j] = '\0'; return(TRUE); } /* copy a string to a buffer */ X_API Term YAP_BufferToString(char *s) { Term t; BACKUP_H(); t = Yap_StringToList(s); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_NBufferToString(char *s, size_t len) { Term t; BACKUP_H(); t = Yap_NStringToList(s, len); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_WideBufferToString(wchar_t *s) { Term t; BACKUP_H(); t = Yap_WideStringToList(s); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_NWideBufferToString(wchar_t *s, size_t len) { Term t; BACKUP_H(); t = Yap_NWideStringToList(s, len); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_ReadBuffer(char *s, Term *tp) { CACHE_REGS Term t; BACKUP_H(); while ((t = Yap_StringToTerm(s,tp)) == 0L) { if (LOCAL_ErrorMessage) { if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) { if (!dogc()) { *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } } else if (!strcmp(LOCAL_ErrorMessage,"Heap Overflow")) { if (!Yap_growheap(FALSE, 0, NULL)) { *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } } else if (!strcmp(LOCAL_ErrorMessage,"Trail Overflow")) { if (!Yap_growtrail (0, FALSE)) { *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } } else { *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } LOCAL_ErrorMessage = NULL; continue; } else { break; } } RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_BufferToAtomList(char *s) { Term t; BACKUP_H(); t = Yap_StringToListOfAtoms(s); RECOVER_H(); return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NBufferToAtomList(char *s, size_t len) { Term t; BACKUP_H(); t = Yap_NStringToListOfAtoms(s, len); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_WideBufferToAtomList(wchar_t *s) { Term t; BACKUP_H(); t = Yap_WideStringToListOfAtoms(s); RECOVER_H(); return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NWideBufferToAtomList(wchar_t *s, size_t len) { Term t; BACKUP_H(); t = Yap_NWideStringToListOfAtoms(s, len); RECOVER_H(); return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len) { Term t; BACKUP_H(); t = Yap_NWideStringToDiffListOfAtoms(s, t0, len); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_BufferToDiffList(char *s, Term t0) { CACHE_REGS Term t; BACKUP_H(); t = Yap_StringToDiffList(s, t0 PASS_REGS); RECOVER_H(); return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NBufferToDiffList(char *s, Term t0, size_t len) { Term t; BACKUP_H(); t = Yap_NStringToDiffList(s, t0, len); RECOVER_H(); return t; } /* copy a string to a buffer */ X_API Term YAP_WideBufferToDiffList(wchar_t *s, Term t0) { Term t; BACKUP_H(); t = Yap_WideStringToDiffList(s, t0); RECOVER_H(); return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len) { Term t; BACKUP_H(); t = Yap_NWideStringToDiffList(s, t0, len); RECOVER_H(); return t; } X_API void YAP_Error(int myerrno, Term t, char *buf,...) { #define YAP_BUF_SIZE 512 va_list ap; char tmpbuf[YAP_BUF_SIZE]; if (!myerrno) myerrno = SYSTEM_ERROR; if (t == 0L) t = TermNil; if (buf != NULL) { va_start (ap, buf); #if HAVE_VSNPRINTF (void) vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap); #else (void) vsprintf(tmpbuf, buf, ap); #endif va_end (ap); } else { tmpbuf[0] = '\0'; } Yap_Error(myerrno,t,tmpbuf); } static int myputc (wchar_t ch) { putc(ch,stderr); return ch; } X_API PredEntry * YAP_FunctorToPred(Functor func) { CACHE_REGS return RepPredProp(PredPropByFunc(func, CurrentModule)); } X_API PredEntry * YAP_AtomToPred(Atom at) { CACHE_REGS return RepPredProp(PredPropByAtom(at, CurrentModule)); } static int run_emulator(YAP_dogoalinfo *dgi) { CACHE_REGS choiceptr myB; int out; BACKUP_MACHINE_REGS(); LOCAL_PrologMode = UserMode; out = Yap_absmi(0); LOCAL_PrologMode = UserCCallMode; myB = (choiceptr)(LCL0-dgi->b); CP = myB->cp_cp; if (!out ) { /* recover stack */ /* on failed computations */ TR = B->cp_tr; H = B->cp_h; #ifdef DEPTH_LIMIT DEPTH = B->cp_depth = DEPTH; #endif /* DEPTH_LIMIT */ YENV = ENV = B->cp_env; ASP = (CELL *)(B+1); Yap_PopSlots( PASS_REGS1 ); B = B->cp_b; HB = B->cp_h; } else { Yap_StartSlots( PASS_REGS1 ); } P = dgi->p; RECOVER_MACHINE_REGS(); return out; } X_API int YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi) { CACHE_REGS UInt i; choiceptr myB; int out; BACKUP_MACHINE_REGS(); dgi->p = P; ptr--; i = pe->ArityOfPE; while (i>0) { XREGS[i] = ptr[i]; i--; } P = pe->CodeOfPred; /* create a choice-point to be tag new goal */ myB = (choiceptr)ASP; myB--; dgi->b = LCL0-(CELL *)myB; myB->cp_tr = TR; myB->cp_h = HB = H; myB->cp_b = B; #ifdef DEPTH_LIMIT myB->cp_depth = DEPTH; #endif /* DEPTH_LIMIT */ myB->cp_cp = CP; myB->cp_ap = NOCODE; myB->cp_env = ENV; CP = YESCODE; B = myB; HB = H; ASP = YENV = (CELL *)B; Yap_PopSlots( PASS_REGS1 ); YENV[E_CB] = Unsigned (B); out = run_emulator(dgi); RECOVER_MACHINE_REGS(); return out; } X_API int YAP_RetryGoal(YAP_dogoalinfo *dgi) { CACHE_REGS choiceptr myB; int out; BACKUP_MACHINE_REGS(); myB = (choiceptr)(LCL0-dgi->b); CP = myB->cp_cp; /* sanity check */ if (B >= myB) { return FALSE; } P = FAILCODE; out = run_emulator(dgi); RECOVER_MACHINE_REGS(); return out; } X_API int YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi) { CACHE_REGS choiceptr myB; BACKUP_MACHINE_REGS(); myB = (choiceptr)(LCL0-dgi->b); if (B > myB) { /* someone cut us */ return FALSE; } /* prune away choicepoints */ if (B != myB) { #ifdef YAPOR CUT_prune_to(myB); #endif B = myB; } /* if backtracking asked for, recover space and bindings */ if (backtrack) { P = FAILCODE; Yap_exec_absmi(TRUE); /* recover stack space */ H = B->cp_h; TR = B->cp_tr; #ifdef DEPTH_LIMIT DEPTH = B->cp_depth; #endif /* DEPTH_LIMIT */ YENV = ENV = B->cp_env; } else { Yap_TrimTrail(); } /* recover local stack */ ASP = (CELL *)(B+1); Yap_PopSlots( PASS_REGS1 ); /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } B = B->cp_b; HB = B->cp_h; P = dgi->p; RECOVER_MACHINE_REGS(); return TRUE; } X_API Term YAP_RunGoal(Term t) { CACHE_REGS Term out; yamop *old_CP = CP; BACKUP_MACHINE_REGS(); LOCAL_AllowRestart = FALSE; LOCAL_PrologMode = UserMode; out = Yap_RunTopGoal(t); LOCAL_PrologMode = UserCCallMode; if (out) { P = (yamop *)ENV[E_CP]; ENV = (CELL *)ENV[E_E]; CP = old_CP; LOCAL_AllowRestart = TRUE; } else { ENV = B->cp_env; B = B->cp_b; LOCAL_AllowRestart = FALSE; } RECOVER_MACHINE_REGS(); return(out); } X_API Term YAP_AllocExternalDataInStack(size_t bytes) { Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes); if (t == TermNil) return 0L; return t; } X_API Bool YAP_IsExternalDataInStackTerm(Term t) { return IsExternalBlobTerm(t, EXTERNAL_BLOB); } X_API void * YAP_ExternalDataInStackFromTerm(Term t) { return ExternalBlobFromTerm (t); } int YAP_NewOpaqueType(void *f) { int i; if (!GLOBAL_OpaqueHandlers) { GLOBAL_OpaqueHandlers = malloc(sizeof(opaque_handler_t)*(USER_BLOB_END-USER_BLOB_START)); if (!GLOBAL_OpaqueHandlers) { /* no room */ return -1; } } else if (GLOBAL_OpaqueHandlersCount == USER_BLOB_END-USER_BLOB_START) { /* all types used */ return -1; } i = GLOBAL_OpaqueHandlersCount++; memcpy(GLOBAL_OpaqueHandlers+i,f,sizeof(opaque_handler_t)); return i+USER_BLOB_START; } Term YAP_NewOpaqueObject(int tag, size_t bytes) { Term t = Yap_AllocExternalDataInStack((CELL)tag, bytes); if (t == TermNil) return 0L; return t; } X_API Bool YAP_IsOpaqueObjectTerm(Term t, int tag) { return IsExternalBlobTerm(t, (CELL)tag); } X_API void * YAP_OpaqueObjectFromTerm(Term t) { return ExternalBlobFromTerm (t); } X_API Term YAP_RunGoalOnce(Term t) { CACHE_REGS Term out; yamop *old_CP = CP; BACKUP_MACHINE_REGS(); LOCAL_PrologMode = UserMode; out = Yap_RunTopGoal(t); LOCAL_PrologMode = UserCCallMode; if (out) { choiceptr cut_pt, ob; ob = NULL; cut_pt = B; while (cut_pt-> cp_ap != NOCODE) { /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(cut_pt->cp_b)) { POP_EXECUTE(); } ob = cut_pt; cut_pt = cut_pt->cp_b; } #ifdef YAPOR CUT_prune_to(cut_pt); #endif if (ob) { B = ob; Yap_TrimTrail(); } B = cut_pt; } ASP = B->cp_env; Yap_PopSlots( PASS_REGS1 ); ENV = (CELL *)ASP[E_E]; B = (choiceptr)ASP[E_CB]; #ifdef DEPTH_LIMIT DEPTH = ASP[E_DEPTH]; #endif P = (yamop *)ASP[E_CP]; CP = old_CP; LOCAL_AllowRestart = FALSE; RECOVER_MACHINE_REGS(); return(out); } X_API int YAP_RestartGoal(void) { CACHE_REGS int out; BACKUP_MACHINE_REGS(); if (LOCAL_AllowRestart) { P = (yamop *)FAILCODE; LOCAL_PrologMode = UserMode; out = Yap_exec_absmi(TRUE); LOCAL_PrologMode = UserCCallMode; if (out == FALSE) { /* cleanup */ Yap_CloseSlots( PASS_REGS1 ); Yap_trust_last(); LOCAL_AllowRestart = FALSE; } } else { out = FALSE; } RECOVER_MACHINE_REGS(); return(out); } X_API int YAP_ShutdownGoal(int backtrack) { CACHE_REGS BACKUP_MACHINE_REGS(); if (LOCAL_AllowRestart) { choiceptr cut_pt; cut_pt = B; while (cut_pt-> cp_ap != NOCODE) { /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(cut_pt->cp_b)) { POP_EXECUTE(); } cut_pt = cut_pt->cp_b; } #ifdef YAPOR CUT_prune_to(cut_pt); #endif /* just force backtrack */ B = cut_pt; if (backtrack) { P = FAILCODE; Yap_exec_absmi(TRUE); /* recover stack space */ H = cut_pt->cp_h; TR = cut_pt->cp_tr; } /* we can always recover the stack */ ASP = cut_pt->cp_env; Yap_PopSlots( PASS_REGS1 ); ENV = (CELL *)ASP[E_E]; B = (choiceptr)ASP[E_CB]; Yap_TrimTrail(); #ifdef DEPTH_LIMIT DEPTH = ASP[E_DEPTH]; #endif LOCAL_AllowRestart = FALSE; } RECOVER_MACHINE_REGS(); return TRUE; } X_API int YAP_ContinueGoal(void) { CACHE_REGS int out; BACKUP_MACHINE_REGS(); LOCAL_PrologMode = UserMode; out = Yap_exec_absmi(TRUE); LOCAL_PrologMode = UserCCallMode; RECOVER_MACHINE_REGS(); return(out); } X_API void YAP_PruneGoal(void) { CACHE_REGS BACKUP_B(); while (B->cp_ap != NOCODE) { /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } B = B->cp_b; } Yap_TrimTrail(); /* make sure that we do not destroy the guard choice-point */ if (Yap_op_from_opcode(B->cp_ap->opc) != _Nstop) B = B->cp_b; RECOVER_B(); } X_API int YAP_GoalHasException(Term *t) { CACHE_REGS int out = FALSE; BACKUP_MACHINE_REGS(); if (EX) { do { LOCAL_Error_TYPE = YAP_NO_ERROR; *t = Yap_FetchTermFromDB(EX); if (LOCAL_Error_TYPE == YAP_NO_ERROR) { RECOVER_MACHINE_REGS(); return TRUE; } else if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } } else { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(EX->NOfCells*CellSize)) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } } } while (*t == (CELL)0); out = TRUE; } RECOVER_MACHINE_REGS(); return out; } X_API void YAP_ClearExceptions(void) { CACHE_REGS Yap_ResetExceptionTerm(); if (EX) { LOCAL_BallTerm = EX; } EX = NULL; Yap_ResetExceptionTerm(); LOCAL_UncaughtThrow = FALSE; } X_API IOSTREAM * YAP_InitConsult(int mode, char *filename) { IOSTREAM *st; BACKUP_MACHINE_REGS(); if (mode == YAP_CONSULT_MODE) Yap_init_consult(FALSE, filename); else Yap_init_consult(TRUE, filename); st = Sopen_file(filename, "r"); RECOVER_MACHINE_REGS(); return st; } X_API IOSTREAM * YAP_TermToStream(Term t) { CACHE_REGS IOSTREAM *s; int rc; extern int PL_get_stream_handle(Int t, IOSTREAM **s); BACKUP_MACHINE_REGS(); if ( (rc=PL_get_stream_handle(Yap_InitSlot(t PASS_REGS), &s)) ) { RECOVER_MACHINE_REGS(); return s; } RECOVER_MACHINE_REGS(); return NULL; } X_API void YAP_EndConsult(IOSTREAM *s) { BACKUP_MACHINE_REGS(); Yap_end_consult(); Sclose(s); RECOVER_MACHINE_REGS(); } X_API Term YAP_Read(IOSTREAM *inp) { CACHE_REGS Term t, tpos = TermNil; TokEntry *tokstart; BACKUP_MACHINE_REGS(); tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, FALSE, &tpos); if (LOCAL_ErrorMessage) { Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); RECOVER_MACHINE_REGS(); return 0; } if (inp->flags & (SIO_FEOF|SIO_FEOF2)) { Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); RECOVER_MACHINE_REGS(); return MkAtomTerm (AtomEof); } t = Yap_Parse(); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); RECOVER_MACHINE_REGS(); return t; } X_API void YAP_Write(Term t, IOSTREAM *stream, int flags) { BACKUP_MACHINE_REGS(); Yap_dowrite (t, stream, flags, 1200); RECOVER_MACHINE_REGS(); } X_API Term YAP_CopyTerm(Term t) { Term tn; BACKUP_MACHINE_REGS(); tn = Yap_CopyTerm(t); RECOVER_MACHINE_REGS(); return tn; } X_API Term YAP_WriteBuffer(Term t, char *buf, unsigned int sze, int flags) { BACKUP_MACHINE_REGS(); t = Yap_TermToString(t, buf, sze, flags); RECOVER_MACHINE_REGS(); return t; } X_API char * YAP_CompileClause(Term t) { CACHE_REGS yamop *codeaddr; int mod = CurrentModule; Term tn = TermNil; BACKUP_MACHINE_REGS(); /* allow expansion during stack initialization */ LOCAL_ErrorMessage = NULL; ARG1 = t; YAPEnterCriticalSection(); codeaddr = Yap_cclause (t,0, mod, t); if (codeaddr != NULL) { t = Deref(ARG1); /* just in case there was an heap overflow */ if (!Yap_addclause (t, codeaddr, TRUE, mod, &tn)) { YAPLeaveCriticalSection(); return LOCAL_ErrorMessage; } } YAPLeaveCriticalSection(); if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) { if (!Yap_growheap(FALSE, 0, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } RECOVER_MACHINE_REGS(); return(LOCAL_ErrorMessage); } static int eof_found = FALSE; static int yap_lineno = 0; static IOSTREAM *bootfile; static char InitFile[] = "init.yap"; static char BootFile[] = "boot.yap"; /* do initial boot by consulting the file boot.yap */ static void do_bootfile (char *bootfilename) { Term t; Term term_end_of_file = MkAtomTerm(AtomEof); Term term_true = YAP_MkAtomTerm(AtomTrue); Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"),1); /* consult boot.pl */ /* the consult mode does not matter here, really */ /* 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. */ bootfile = YAP_InitConsult(YAP_CONSULT_MODE,bootfilename); if (bootfile == NULL) { fprintf(stderr, "[ FATAL ERROR: could not open bootfile %s ]\n", bootfilename); exit(1); } while (!eof_found) { t = YAP_Read(bootfile); if (eof_found) { break; } if (t == 0) { fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", bootfilename, yap_lineno); exit(1); } if (YAP_IsVarTerm (t) || t == TermNil) { continue; } else if (t == term_true) { YAP_Exit(0); } else if (t == term_end_of_file) { break; } 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, Sseek(bootfile,0L,SEEK_CUR)); } else if (YAP_IsApplTerm (t) && FunctorOfTerm (t) == functor_query) { YAP_RunGoalOnce(ArgOfTerm (1, t)); } else { char *ErrorMessage = YAP_CompileClause(t); if (ErrorMessage) fprintf(stderr, "%s", ErrorMessage); } /* do backtrack */ YAP_Reset(); } YAP_EndConsult(bootfile); #ifdef DEBUG if (output_msg) fprintf(stderr,"Boot loaded\n"); #endif } static void construct_init_file(char *boot_file, char *BootFile) { /* trust YAPSHAREDIR over YAP_PL_SRCDIR, and notice that the code is / dependent. */ #if HAVE_GETENV if (getenv("YAPSHAREDIR")) { strncpy(boot_file, getenv("YAPSHAREDIR"), 256); strncat(boot_file, "/pl/", 255); } else { #endif strncpy(boot_file, YAP_PL_SRCDIR, 256); strncat(boot_file, "/", 255); #if HAVE_GETENV } #endif strncat(boot_file, BootFile, 255); } /* this routine is supposed to be called from an external program that wants to control Yap */ #if defined(USE_SYSTEM_MALLOC) #define BOOT_FROM_SAVED_STATE FALSE #else #define BOOT_FROM_SAVED_STATE TRUE #endif X_API Int YAP_Init(YAP_init_args *yap_init) { CACHE_REGS int restore_result; int do_bootstrap = (yap_init->YapPrologBootFile != NULL); CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; static char boot_file[256]; Yap_InitPageSize(); /* init memory page size, required by later functions */ #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) Yap_init_yapor_global_local_memory(); LOCAL = REMOTE(0); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ GLOBAL_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts; Yap_InitSysbits(); /* init signal handling and time, required by later functions */ GLOBAL_argv = yap_init->Argv; GLOBAL_argc = yap_init->Argc; #if !BOOT_FROM_SAVED_STATE if (yap_init->SavedState) { fprintf(stderr,"[ WARNING: threaded YAP will ignore saved state %s ]\n",yap_init->SavedState); yap_init->SavedState = NULL; } #endif if (BOOT_FROM_SAVED_STATE && !do_bootstrap) { if (Yap_SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap) != 1) { yap_init->ErrorNo = LOCAL_Error_TYPE; yap_init->ErrorCause = LOCAL_ErrorMessage; return YAP_BOOT_ERROR; } } if (yap_init->TrailSize == 0) { if (yap_init->MaxTrailSize) { Trail = yap_init->MaxTrailSize; } else if (Trail == 0) Trail = DefTrailSpace; } else { Trail = yap_init->TrailSize; } Atts = yap_init->AttsSize; if (yap_init->StackSize == 0) { if (yap_init->MaxStackSize || yap_init->MaxGlobalSize) { if (yap_init->MaxStackSize) { if (yap_init->MaxGlobalSize) { Stack = yap_init->MaxStackSize+yap_init->MaxGlobalSize; } else { Stack = yap_init->MaxStackSize+DefStackSpace/2; } } else { Stack = yap_init->MaxGlobalSize+DefStackSpace/2; } } else if (Stack == 0) Stack = DefStackSpace; } else { Stack = yap_init->StackSize; } if (yap_init->HeapSize == 0) { if (Heap == 0) Heap = DefHeapSpace; } else { Heap = yap_init->HeapSize; } Yap_InitWorkspace(Heap, Stack, Trail, Atts, yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad ); #if THREADS /* make sure we use the correct value of regcache */ regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key)); #endif #if USE_SYSTEM_MALLOC if (Trail < MinTrailSpace) Trail = MinTrailSpace; if (Stack < MinStackSpace) Stack = MinStackSpace; if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) { yap_init->ErrorNo = RESOURCE_ERROR_MEMORY; yap_init->ErrorCause = "could not allocate stack space for main thread"; return YAP_BOOT_ERROR; } #if THREADS /* don't forget this is a thread */ LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase; LOCAL_ThreadHandle.ssize = Trail+Stack; #endif #endif GLOBAL_AllowGlobalExpansion = TRUE; GLOBAL_AllowLocalExpansion = TRUE; GLOBAL_AllowTrailExpansion = TRUE; Yap_InitExStacks (Trail, Stack); if (yap_init->QuietMode) { yap_flags[QUIET_MODE_FLAG] = TRUE; } { BACKUP_MACHINE_REGS(); Yap_InitYaamRegs(); #if HAVE_MPI Yap_InitMPI (); #endif #if HAVE_MPE Yap_InitMPE (); #endif if (yap_init->YapPrologRCFile != NULL) { /* This must be done before restore, otherwise restore will print out messages .... */ yap_flags[HALT_AFTER_CONSULT_FLAG] = yap_init->HaltAfterConsult; } /* tell the system who should cope with interruptions */ Yap_ExecutionMode = yap_init->ExecutionMode; if (do_bootstrap) { restore_result = YAP_BOOT_FROM_PROLOG; } else if (BOOT_FROM_SAVED_STATE) { restore_result = Yap_Restore(yap_init->SavedState, yap_init->YapLibDir); if (restore_result == FAIL_RESTORE) { yap_init->ErrorNo = LOCAL_Error_TYPE; yap_init->ErrorCause = LOCAL_ErrorMessage; /* shouldn't RECOVER_MACHINE_REGS(); be here ??? */ return YAP_BOOT_ERROR; } } else { restore_result = YAP_BOOT_FROM_PROLOG; } yap_flags[FAST_BOOT_FLAG] = yap_init->FastBoot; #if defined(YAPOR) || defined(TABLING) Yap_init_root_frames(); #endif /* YAPOR || TABLING */ #ifdef YAPOR Yap_init_yapor_workers(); if (worker_id != 0) { #if defined(YAPOR_COPY) || defined(YAPOR_SBA) /* In the SBA we cannot just happily inherit registers from the other workers */ Yap_InitYaamRegs(); #endif /* YAPOR_COPY || YAPOR_SBA */ #ifndef YAPOR_THREADS Yap_InitPreAllocCodeSpace(); #endif /* YAPOR_THREADS */ /* slaves, waiting for work */ CurrentModule = USER_MODULE; P = GETWORK_FIRST_TIME; Yap_exec_absmi(FALSE); Yap_Error(INTERNAL_ERROR, TermNil, "abstract machine unexpected exit (YAP_Init)"); } #endif /* YAPOR */ RECOVER_MACHINE_REGS(); } /* make sure we do this after restore */ if (yap_init->MaxStackSize) { GLOBAL_AllowLocalExpansion = FALSE; } else { GLOBAL_AllowLocalExpansion = TRUE; } if (yap_init->MaxGlobalSize) { GLOBAL_AllowGlobalExpansion = FALSE; } else { GLOBAL_AllowGlobalExpansion = TRUE; } if (yap_init->MaxTrailSize) { GLOBAL_AllowTrailExpansion = FALSE; } else { GLOBAL_AllowTrailExpansion = TRUE; } if (yap_init->YapPrologRCFile) { Yap_PutValue(AtomConsultOnBoot, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologRCFile))); /* This must be done again after restore, as yap_flags has been overwritten .... */ yap_flags[HALT_AFTER_CONSULT_FLAG] = yap_init->HaltAfterConsult; } #ifdef MYDDAS_MYSQL if (yap_init->myddas) { Yap_PutValue(AtomMyddasGoal,MkIntegerTerm(yap_init->myddas)); /* Mandatory Fields */ Yap_PutValue(AtomMyddasUser,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_user))); Yap_PutValue(AtomMyddasDB,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_db))); /* Non-Mandatory Fields */ if (yap_init->myddas_pass != NULL) Yap_PutValue(AtomMyddasPass,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_pass))); if (yap_init->myddas_host != NULL) Yap_PutValue(AtomMyddasHost,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_host))); } #endif if (yap_init->YapPrologTopLevelGoal) { Yap_PutValue(AtomTopLevelGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal))); } if (yap_init->YapPrologGoal) { Yap_PutValue(AtomInitGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologGoal))); } if (yap_init->YapPrologAddPath) { Yap_PutValue(AtomExtendFileSearchPath, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologAddPath))); } if (yap_init->QuietMode) { yap_flags[QUIET_MODE_FLAG] = TRUE; } if (BOOT_FROM_SAVED_STATE && !do_bootstrap) { if (restore_result == FAIL_RESTORE) { yap_init->ErrorNo = LOCAL_Error_TYPE; yap_init->ErrorCause = LOCAL_ErrorMessage; return YAP_BOOT_ERROR; } if (Atts && Atts*1024 > 2048*sizeof(CELL)) Yap_AttsSize = Atts*1024; else Yap_AttsSize = 2048*sizeof(CELL); if (restore_result == DO_ONLY_CODE) { /* first, initialise the saved state */ Term t_goal = MkAtomTerm(AtomStartupSavedState); YAP_RunGoalOnce(t_goal); Yap_InitYaamRegs(); /* reset stacks */ return YAP_BOOT_FROM_SAVED_CODE; } else { return YAP_BOOT_FROM_SAVED_STACKS; } } else { /* read the bootfile */ if (!do_bootstrap) { construct_init_file(boot_file, BootFile); yap_init->YapPrologBootFile = boot_file; } do_bootfile (yap_init->YapPrologBootFile ? yap_init->YapPrologBootFile : BootFile); /* initialise the top-level */ if (!do_bootstrap) { char init_file[256]; Atom atfile; Functor fgoal; YAP_Term goal, as[2]; construct_init_file(init_file, InitFile); /* consult init file */ atfile = Yap_LookupAtom(init_file); as[0] = MkAtomTerm(atfile); fgoal = Yap_MkFunctor(Yap_FullLookupAtom("$silent_bootstrap"), 1); goal = Yap_MkApplTerm(fgoal, 1, as); /* launch consult */ YAP_RunGoalOnce(goal); /* set default module to user */ as[0] = MkAtomTerm(AtomUser); fgoal = Yap_MkFunctor(Yap_LookupAtom("module"), 1); goal = Yap_MkApplTerm(fgoal, 1, as); YAP_RunGoalOnce(goal); /* reset stacks */ Yap_InitYaamRegs(); } Yap_PutValue(Yap_FullLookupAtom("$live"), MkAtomTerm (Yap_FullLookupAtom("$true"))); } return YAP_BOOT_FROM_PROLOG; } X_API Int YAP_FastInit(char saved_state[]) { YAP_init_args init_args; Int out; init_args.SavedState = saved_state; init_args.AttsSize = 0; init_args.HeapSize = 0; init_args.StackSize = 0; init_args.TrailSize = 0; init_args.MaxAttsSize = 0; init_args.MaxHeapSize = 0; init_args.MaxStackSize = 0; init_args.MaxGlobalSize = 0; init_args.MaxTrailSize = 0; init_args.YapLibDir = NULL; init_args.YapPrologBootFile = NULL; init_args.YapPrologInitFile = NULL; init_args.YapPrologRCFile = NULL; init_args.YapPrologGoal = NULL; init_args.YapPrologTopLevelGoal = NULL; init_args.YapPrologAddPath = NULL; init_args.HaltAfterConsult = FALSE; init_args.FastBoot = FALSE; init_args.NumberWorkers = 1; init_args.SchedulerLoop = 10; init_args.DelayedReleaseLoad = 3; init_args.PrologShouldHandleInterrupts = FALSE; init_args.ExecutionMode = INTERPRETED; init_args.Argc = 0; init_args.Argv = NULL; init_args.ErrorNo = 0; init_args.ErrorCause = NULL; init_args.QuietMode = FALSE; out = YAP_Init(&init_args); if (out == YAP_BOOT_ERROR) { Yap_Error(init_args.ErrorNo,TermNil,init_args.ErrorCause); } return out; } X_API void YAP_PutValue(Atom at, Term t) { Yap_PutValue(at, t); } X_API Term YAP_GetValue(Atom at) { return(Yap_GetValue(at)); } X_API int YAP_CompareTerms(Term t1, Term t2) { return Yap_compare_terms(t1, t2); } X_API int YAP_Reset(void) { CACHE_REGS BACKUP_MACHINE_REGS(); /* first, backtrack to the root */ if (B != NULL) { while (B->cp_b != NULL) B = B->cp_b; P = (yamop *)FAILCODE; if (Yap_exec_absmi(0) != 0) return(FALSE); } /* reinitialise the engine */ Yap_InitYaamRegs(); GLOBAL_Initialised = TRUE; RECOVER_MACHINE_REGS(); return(TRUE); } X_API void YAP_Exit(int retval) { Yap_exit(retval); } X_API void YAP_InitSocks(char *host, long port) { } X_API void YAP_SetOutputMessage(void) { #if DEBUG Yap_output_msg = TRUE; #endif } X_API int YAP_StreamToFileNo(Term t) { return(Yap_StreamToFileNo(t)); } X_API void YAP_CloseAllOpenStreams(void) { BACKUP_H(); Yap_CloseStreams(FALSE); RECOVER_H(); } X_API void YAP_FlushAllStreams(void) { BACKUP_H(); // VSC?? Yap_FlushStreams(); RECOVER_H(); } X_API void YAP_Throw(Term t) { BACKUP_MACHINE_REGS(); Yap_JumpToEnv(t); RECOVER_MACHINE_REGS(); } X_API void YAP_AsyncThrow(Term t) { CACHE_REGS BACKUP_MACHINE_REGS(); LOCAL_PrologMode |= AsyncIntMode; Yap_JumpToEnv(t); LOCAL_PrologMode &= ~AsyncIntMode; RECOVER_MACHINE_REGS(); } X_API void YAP_Halt(int i) { Yap_exit(i); } X_API CELL * YAP_TopOfLocalStack(void) { CACHE_REGS return(ASP); } X_API void * YAP_Predicate(Atom a, UInt arity, Term m) { if (arity == 0) { return((void *)RepPredProp(PredPropByAtom(a,m))); } else { Functor f = Yap_MkFunctor(a, arity); return((void *)RepPredProp(PredPropByFunc(f,m))); } } X_API void YAP_PredicateInfo(void *p, Atom* a, UInt* arity, Term* m) { PredEntry *pd = (PredEntry *)p; if (pd->ArityOfPE) { *arity = pd->ArityOfPE; *a = NameOfFunctor(pd->FunctorOfPred); } else { *arity = 0; *a = (Atom)(pd->FunctorOfPred); } if (pd->ModuleOfPred) *m = pd->ModuleOfPred; else *m = TermProlog; } X_API void YAP_UserCPredicate(char *name, CPredicate def, UInt arity) { Yap_InitCPred(name, arity, def, UserCPredFlag); } X_API void YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont, UInt arity, unsigned int extra) { #ifdef CUT_C Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL ,UserCPredFlag); #else Yap_InitCPredBack(name, arity, extra, init, cont, UserCPredFlag); #endif } #ifdef CUT_C X_API void YAP_UserBackCutCPredicate(char *name, CPredicate init, CPredicate cont, CPredicate cut, UInt arity, unsigned int extra) { Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag); } #endif X_API void YAP_UserCPredicateWithArgs(char *a, CPredicate f, UInt arity, Term mod) { CACHE_REGS PredEntry *pe; Term cm = CurrentModule; CurrentModule = mod; YAP_UserCPredicate(a,f,arity); if (arity == 0) { pe = RepPredProp(PredPropByAtom(Yap_LookupAtom(a),mod)); } else { Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity); pe = RepPredProp(PredPropByFunc(f,mod)); } pe->PredFlags |= CArgsPredFlag; CurrentModule = cm; } X_API Term YAP_CurrentModule(void) { CACHE_REGS return(CurrentModule); } X_API Term YAP_SetCurrentModule(Term new) { CACHE_REGS Term omod = CurrentModule; CurrentModule = new; return omod; } X_API Term YAP_CreateModule(Atom at) { Term t; WRITE_LOCK(RepAtom(at)->ARWLock); t = Yap_Module(MkAtomTerm(at)); WRITE_UNLOCK(RepAtom(at)->ARWLock); return t; } X_API Term YAP_StripModule(Term t, Term *modp) { return Yap_StripModule(t, modp); } X_API int YAP_ThreadSelf(void) { #if THREADS return Yap_thread_self(); #else return -2; #endif } X_API int YAP_ThreadCreateEngine(struct thread_attr_struct * attr) { #if THREADS return Yap_thread_create_engine(attr); #else return -1; #endif } X_API int YAP_ThreadAttachEngine( int wid) { #if THREADS return Yap_thread_attach_engine(wid); #else return FALSE; #endif } X_API int YAP_ThreadDetachEngine(int wid) { #if THREADS return Yap_thread_detach_engine(wid); #else return FALSE; #endif } X_API int YAP_ThreadDestroyEngine(int wid) { #if THREADS return Yap_thread_destroy_engine(wid); #else return FALSE; #endif } X_API Term YAP_TermNil(void) { return TermNil; } X_API int YAP_AtomGetHold(Atom at) { return Yap_AtomIncreaseHold(at); } X_API int YAP_AtomReleaseHold(Atom at) { return Yap_AtomDecreaseHold(at); } X_API Agc_hook YAP_AGCRegisterHook(Agc_hook hook) { Agc_hook old = GLOBAL_AGCHook; GLOBAL_AGCHook = hook; return old; } X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void * closure) { return Yap_HaltRegisterHook(hook, closure); } X_API char * YAP_cwd(void) { CACHE_REGS char *buf; int len; if (!Yap_getcwd(LOCAL_FileNameBuf, YAP_FILENAME_MAX)) return FALSE; len = strlen(LOCAL_FileNameBuf); buf = Yap_AllocCodeSpace(len+1); if (!buf) return NULL; strncpy(buf, LOCAL_FileNameBuf, len); return buf; } X_API Term YAP_OpenList(int n) { CACHE_REGS Term t; BACKUP_H(); if (H+2*n > ASP-1024) { if (!dogc()) { RECOVER_H(); return FALSE; } } t = AbsPair(H); H += 2*n; RECOVER_H(); return t; } X_API Term YAP_ExtendList(Term t0, Term inp) { Term t; CELL *ptr = RepPair(t0); BACKUP_H(); ptr[0] = inp; ptr[1] = AbsPair(ptr+2); t = AbsPair(ptr+2); RECOVER_H(); return t; } X_API int YAP_CloseList(Term t0, Term tail) { CELL *ptr = RepPair(t0); RESET_VARIABLE(ptr-1); if (!Yap_unify((Term)(ptr-1), tail)) return FALSE; return TRUE; } X_API int YAP_IsAttVar(Term t) { t = Deref(t); if (!IsVarTerm(t)) return FALSE; return IsAttVar(VarOfTerm(t)); } X_API Term YAP_AttsOfVar(Term t) { attvar_record *attv; t = Deref(t); if (!IsVarTerm(t)) return TermNil; if (IsAttVar(VarOfTerm(t))) return TermNil; attv = (attvar_record *)VarOfTerm(t); return attv->Atts; } X_API int YAP_FileNoFromStream(Term t) { t = Deref(t); if (IsVarTerm(t)) return -1; return Yap_StreamToFileNo(t); return -1; } X_API void * YAP_FileDescriptorFromStream(Term t) { t = Deref(t); if (IsVarTerm(t)) return NULL; return Yap_FileDescriptorFromStream(t); return NULL; } X_API void * YAP_Record(Term t) { DBTerm *dbterm; DBRecordList *dbt; dbterm = Yap_StoreTermInDB(Deref(t), 0); if (dbterm == NULL) return NULL; dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list)); while (dbt == NULL) { if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) { /* be a good neighbor */ Yap_FreeCodeSpace((void *)dbterm); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "using YAP_Record"); return NULL; } } if (Yap_Records) { Yap_Records->prev_rec = dbt; } dbt->next_rec = Yap_Records; dbt->prev_rec = NULL; dbt->dbrecord = dbterm; Yap_Records = dbt; return dbt; } X_API Term YAP_Recorded(void *handle) { CACHE_REGS Term t; DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord; BACKUP_MACHINE_REGS(); do { LOCAL_Error_TYPE = YAP_NO_ERROR; t = Yap_FetchTermFromDB(dbterm); if (LOCAL_Error_TYPE == YAP_NO_ERROR) { RECOVER_MACHINE_REGS(); return t; } else if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } } else { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(dbterm->NOfCells*CellSize)) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } } } while (t == (CELL)0); RECOVER_MACHINE_REGS(); return t; } X_API int YAP_Erase(void *handle) { DBRecordList *dbr = (DBRecordList *)handle; if (dbr->next_rec) dbr->next_rec->prev_rec = dbr->prev_rec; if (dbr->prev_rec) dbr->prev_rec->next_rec = dbr->next_rec; else if (Yap_Records == dbr) { Yap_Records = dbr->next_rec; } Yap_ReleaseTermFromDB(dbr->dbrecord); Yap_FreeCodeSpace(handle); return 1; } X_API Int YAP_ArgsToSlots(int n) { CACHE_REGS Int slot = Yap_NewSlots(n PASS_REGS); CELL *ptr0 = LCL0+slot, *ptr1=&ARG1; while (n--) { *ptr0++ = *ptr1++; } return slot; } X_API void YAP_SlotsToArgs(int n, Int slot) { CACHE_REGS CELL *ptr0 = LCL0+slot, *ptr1=&ARG1; while (n--) { *ptr1++ = *ptr0++; } } X_API void YAP_signal(int sig) { Yap_signal(sig); } X_API int YAP_SetYAPFlag(yap_flag_t flag, int val) { switch (flag) { case YAPC_ENABLE_GC: if (val) { Yap_PutValue(AtomGc, MkAtomTerm(AtomTrue)); } else { Yap_PutValue(AtomGc, TermNil); } return TRUE; case YAPC_ENABLE_AGC: if (val) { GLOBAL_AGcThreshold = 10000; } else { GLOBAL_AGcThreshold = 0; } return TRUE; default: return FALSE; } } /* Int YAP_VarSlotToNumber(Int) */ Int YAP_VarSlotToNumber(Int s) { CACHE_REGS Term *t = (CELL *)Deref(Yap_GetFromSlot(s PASS_REGS)); if (t < H) return t-H0; return t-LCL0; } /* Term YAP_ModuleUser() */ Term YAP_ModuleUser(void) { return MkAtomTerm(AtomUser); } /* int YAP_PredicateHasClauses() */ Int YAP_NumberOfClausesForPredicate(PredEntry *pe) { return pe->cs.p_code.NOfClauses; } int YAP_MaxOpPriority(Atom at, Term module) { AtomEntry *ae = RepAtom(at); OpEntry *info; WRITE_LOCK(ae->ARWLock); info = Yap_GetOpPropForAModuleHavingALock(ae, module); if (!info) { WRITE_UNLOCK(ae->ARWLock); return 0; } int ret = info->Prefix; if (info->Infix > ret) ret = info->Infix; if (info->Posfix > ret) ret = info->Posfix; WRITE_UNLOCK(ae->ARWLock); return ret; } int YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio) { AtomEntry *ae = RepAtom(at); OpEntry *info; int n; WRITE_LOCK(ae->ARWLock); info = Yap_GetOpPropForAModuleHavingALock(ae, module); if (!info) { /* try system operators */ info = Yap_GetOpPropForAModuleHavingALock(ae, PROLOG_MODULE); if (!info) { WRITE_UNLOCK(ae->ARWLock); return 0; } } if (opkind == PREFIX_OP) { SMALLUNSGN p = info->Prefix; if (!p) { WRITE_UNLOCK(ae->ARWLock); return FALSE; } if (p & DcrrpFlag) { n = 6; *prio = (p ^ DcrrpFlag); } else { n = 7; *prio = p; } } else if (opkind == INFIX_OP) { SMALLUNSGN p = info->Infix; if (!p) { WRITE_UNLOCK(ae->ARWLock); return FALSE; } if ((p & DcrrpFlag) && (p & DcrlpFlag)) { n = 1; *prio = (p ^ (DcrrpFlag | DcrlpFlag)); } else if (p & DcrrpFlag) { n = 3; *prio = (p ^ DcrrpFlag); } else if (p & DcrlpFlag) { n = 2; *prio = (p ^ DcrlpFlag); } else { n = 4; *prio = p; } } else { SMALLUNSGN p = info->Posfix; if (p & DcrlpFlag) { n = 4; *prio = (p ^ DcrlpFlag); } else { n = 5; *prio = p; } } *yap_type = n; WRITE_UNLOCK(ae->ARWLock); return 1; }