1 /*************************************************************************
2 * *
3 * YAP Prolog *
4 * Yap Prolog was developed at NCCUP - Universidade do Porto *
5 * *
6 * Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- *
7 * *
8 **************************************************************************
9 * *
10 * File: c_interface.c *
11 * comments: c_interface primitives definition *
12 * *
13 * Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ *
14 * $Log: not supported by cvs2svn $
15 * Revision 1.122 2008/08/01 21:44:24 vsc
16 * swi compatibility support
17 *
18 * Revision 1.121 2008/07/24 16:02:00 vsc
19 * improve C-interface and SWI comptaibility a bit.
20 *
21 * Revision 1.120 2008/07/11 17:02:07 vsc
22 * fixes by Bart and Tom: mostly libraries but nasty one in indexing
23 * compilation.
24 *
25 * Revision 1.119 2008/06/17 13:37:48 vsc
26 * fix c_interface not to crash when people try to recover slots that are
27 * not there.
28 * fix try_logical and friends to handle case where predicate has arity 0.
29 *
30 * Revision 1.118 2008/06/04 14:47:18 vsc
31 * make sure we do trim_trail whenever we mess with B!
32 *
33 * Revision 1.117 2008/06/04 13:58:36 vsc
34 * more fixes to C-interface
35 *
36 * Revision 1.116 2008/04/28 23:02:32 vsc
37 * fix bug in current_predicate/2
38 * fix bug in c_interface.
39 *
40 * Revision 1.115 2008/04/11 16:30:27 ricroc
41 * *** empty log message ***
42 *
43 * Revision 1.114 2008/04/04 13:35:41 vsc
44 * fix duplicate dependency frame at entry
45 *
46 * Revision 1.113 2008/04/04 09:10:02 vsc
47 * restore was restoring twice
48 *
49 * Revision 1.112 2008/04/03 13:26:38 vsc
50 * protect signal handling with locks for threaded version.
51 * fix close/1 entry in manual (obs from Nicos).
52 * fix -f option in chr Makefile.
53 *
54 * Revision 1.111 2008/04/02 21:44:07 vsc
55 * threaded version should ignore saved states (for now).
56 *
57 * Revision 1.110 2008/04/02 17:37:06 vsc
58 * handle out of memory error at thread creation (obs from Paulo Moura).
59 *
60 * Revision 1.109 2008/04/01 15:31:41 vsc
61 * more saved state fixes
62 *
63 * Revision 1.108 2008/03/22 23:35:00 vsc
64 * fix bug in all_calls
65 *
66 * Revision 1.107 2008/03/13 18:41:50 vsc
67 * -q flag
68 *
69 * Revision 1.106 2008/02/12 17:03:50 vsc
70 * SWI-portability changes
71 *
72 * Revision 1.105 2008/01/28 10:42:19 vsc
73 * fix BOM trouble
74 *
75 * Revision 1.104 2007/12/05 12:17:23 vsc
76 * improve JT
77 * fix graph compatibility with SICStus
78 * re-export declaration.
79 *
80 * Revision 1.103 2007/11/16 14:58:40 vsc
81 * implement sophisticated operations with matrices.
82 *
83 * Revision 1.102 2007/11/01 20:50:31 vsc
84 * fix YAP_LeaveGoal (again)
85 *
86 * Revision 1.101 2007/10/29 22:48:54 vsc
87 * small fixes
88 *
89 * Revision 1.100 2007/10/28 00:54:09 vsc
90 * new version of viterbi implementation
91 * fix all:atvars reporting bad info
92 * fix bad S info in x86_64
93 *
94 * Revision 1.99 2007/10/16 18:57:17 vsc
95 * get rid of debug statement.
96 *
97 * Revision 1.98 2007/10/15 23:48:46 vsc
98 * unset var
99 *
100 * Revision 1.97 2007/10/05 18:24:30 vsc
101 * fix garbage collector and fix LeaveGoal
102 *
103 * Revision 1.96 2007/09/04 10:34:54 vsc
104 * Improve SWI interface emulation.
105 *
106 * Revision 1.95 2007/06/04 12:28:01 vsc
107 * interface speedups
108 * bad error message in X is foo>>2.
109 *
110 * Revision 1.94 2007/05/15 11:33:51 vsc
111 * fix min list
112 *
113 * Revision 1.93 2007/05/14 16:44:11 vsc
114 * improve external interface
115 *
116 * Revision 1.92 2007/04/18 23:01:16 vsc
117 * fix deadlock when trying to create a module with the same name as a
118 * predicate (for now, just don't lock modules). obs Paulo Moura.
119 *
120 * Revision 1.91 2007/03/30 16:47:22 vsc
121 * fix gmpless blob handling
122 *
123 * Revision 1.90 2007/03/22 11:12:20 vsc
124 * make sure that YAP_Restart does not restart a failed goal.
125 *
126 * Revision 1.89 2007/01/28 14:26:36 vsc
127 * WIN32 support
128 *
129 * Revision 1.88 2007/01/08 08:27:19 vsc
130 * fix restore (Trevor)
131 * make indexing a bit faster on IDB
132 *
133 * Revision 1.87 2006/12/13 16:10:14 vsc
134 * several debugger and CLP(BN) improvements.
135 *
136 * Revision 1.86 2006/11/27 17:42:02 vsc
137 * support for UNICODE, and other bug fixes.
138 *
139 * Revision 1.85 2006/05/16 18:37:30 vsc
140 * WIN32 fixes
141 * compiler bug fixes
142 * extend interface
143 *
144 * Revision 1.84 2006/03/09 15:52:04 tiagosoares
145 * CUT_C and MYDDAS support for 64 bits architectures
146 *
147 * Revision 1.83 2006/02/08 17:29:54 tiagosoares
148 * MYDDAS: Myddas Top Level for MySQL and Datalog
149 *
150 * Revision 1.82 2006/01/18 15:34:53 vsc
151 * avoid sideffects from MkBigInt
152 *
153 * Revision 1.81 2006/01/16 02:57:51 vsc
154 * fix bug with very large integers
155 * fix bug where indexing code was looking at code after a cut.
156 *
157 * Revision 1.80 2006/01/02 03:35:44 vsc
158 * fix interface and docs
159 *
160 * Revision 1.79 2006/01/02 02:25:44 vsc
161 * cannot release space from external GMPs.
162 *
163 * Revision 1.78 2006/01/02 02:16:18 vsc
164 * support new interface between YAP and GMP, so that we don't rely on our own
165 * allocation routines.
166 * Several big fixes.
167 *
168 * Revision 1.77 2005/11/18 18:48:51 tiagosoares
169 * support for executing c code when a cut occurs
170 *
171 * Revision 1.76 2005/11/03 18:49:26 vsc
172 * fix bignum conversion
173 *
174 * Revision 1.75 2005/10/28 17:38:49 vsc
175 * sveral updates
176 *
177 * Revision 1.74 2005/10/21 16:07:07 vsc
178 * fix tabling
179 *
180 * Revision 1.73 2005/10/18 17:04:43 vsc
181 * 5.1:
182 * - improvements to GC
183 * 2 generations
184 * generic speedups
185 * - new scheme for attvars
186 * - hProlog like interface also supported
187 * - SWI compatibility layer
188 * - extra predicates
189 * - global variables
190 * - moved to Prolog module
191 * - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart
192 * Demoen and Jan Wielemacker
193 * - load_files/2
194 *
195 * from 5.0.1
196 *
197 * - WIN32 missing include files (untested)
198 * - -L trouble (my thanks to Takeyuchi Shiramoto-san)!
199 * - debugging of backtrable user-C preds would core dump.
200 * - redeclaring a C-predicate as Prolog core dumps.
201 * - badly protected YapInterface.h.
202 * - break/0 was failing at exit.
203 * - YAP_cut_fail and YAP_cut_succeed were different from manual.
204 * - tracing through data-bases could core dump.
205 * - cut could break on very large computations.
206 * - first pass at BigNum issues (reported by Roberto).
207 * - debugger could get go awol after fail port.
208 * - weird message on wrong debugger option.
209 *
210 * Revision 1.72 2005/10/15 02:42:57 vsc
211 * fix interface
212 *
213 * Revision 1.71 2005/08/17 13:35:51 vsc
214 * YPP would leave exceptions on the system, disabling Yap-4.5.7
215 * message.
216 *
217 * Revision 1.70 2005/08/04 15:45:51 ricroc
218 * TABLING NEW: support to limit the table space size
219 *
220 * Revision 1.69 2005/07/19 17:12:18 rslopes
221 * fix for older compilers that do not support declaration of vars
222 * in the middle of the function code.
223 *
224 * Revision 1.68 2005/05/31 00:23:47 ricroc
225 * remove abort_yapor function
226 *
227 * Revision 1.67 2005/04/10 04:35:19 vsc
228 * AllocMemoryFromYap should now handle large requests the right way.
229 *
230 * Revision 1.66 2005/04/10 04:01:10 vsc
231 * bug fixes, I hope!
232 *
233 * Revision 1.65 2005/03/15 18:29:23 vsc
234 * fix GPL
235 * fix idb: stuff in coroutines.
236 *
237 * Revision 1.64 2005/03/13 06:26:10 vsc
238 * fix excessive pruning in meta-calls
239 * fix Term->int breakage in compiler
240 * improve JPL (at least it does something now for amd64).
241 *
242 * Revision 1.63 2005/03/04 20:30:10 ricroc
243 * bug fixes for YapTab support
244 *
245 * Revision 1.62 2005/03/02 18:35:44 vsc
246 * try to make initialisation process more robust
247 * try to make name more robust (in case Lookup new atom fails)
248 *
249 * Revision 1.61 2005/03/01 22:25:08 vsc
250 * fix pruning bug
251 * make DL_MALLOC less enthusiastic about walking through buckets.
252 *
253 * Revision 1.60 2005/02/08 18:04:47 vsc
254 * library_directory may not be deterministic (usually it isn't).
255 *
256 * Revision 1.59 2004/12/08 00:56:35 vsc
257 * missing ;
258 *
259 * Revision 1.58 2004/11/19 22:08:41 vsc
260 * replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
261 *
262 * Revision 1.57 2004/11/18 22:32:31 vsc
263 * fix situation where we might assume nonextsing double initialisation of C predicates (use
264 * Hidden Pred Flag).
265 * $host_type was double initialised.
266 *
267 * Revision 1.56 2004/10/31 02:18:03 vsc
268 * fix bug in handling Yap heap overflow while adding new clause.
269 *
270 * Revision 1.55 2004/10/28 20:12:20 vsc
271 * Use Doug Lea's malloc as an alternative to YAP's standard malloc
272 * don't use TR directly in scanner/parser, this avoids trouble with ^C while
273 * consulting large files.
274 * pass gcc -mno-cygwin to library compilation in cygwin environment (cygwin should
275 * compile out of the box now).
276 *
277 * Revision 1.54 2004/10/06 16:55:46 vsc
278 * change configure to support big mem configs
279 * get rid of extra globals
280 * fix trouble with multifile preds
281 *
282 * Revision 1.53 2004/08/11 16:14:51 vsc
283 * whole lot of fixes:
284 * - memory leak in indexing
285 * - memory management in WIN32 now supports holes
286 * - extend Yap interface, more support for SWI-Interface
287 * - new predicate mktime in system
288 * - buffer console I/O in WIN32
289 *
290 * Revision 1.52 2004/07/23 03:37:16 vsc
291 * fix heap overflow in YAP_LookupAtom
292 *
293 * Revision 1.51 2004/07/22 21:32:20 vsc
294 * debugger fixes
295 * initial support for JPL
296 * bad calls to garbage collector and gc
297 * debugger fixes
298 *
299 * Revision 1.50 2004/06/29 19:04:41 vsc
300 * fix multithreaded version
301 * include new version of Ricardo's profiler
302 * new predicat atomic_concat
303 * allow multithreaded-debugging
304 * small fixes
305 *
306 * Revision 1.49 2004/06/09 03:32:02 vsc
307 * fix bugs
308 *
309 * Revision 1.48 2004/06/05 03:36:59 vsc
310 * coroutining is now a part of attvars.
311 * some more fixes.
312 *
313 * Revision 1.47 2004/05/17 21:42:08 vsc
314 * misc fixes
315 *
316 * Revision 1.46 2004/05/14 17:56:45 vsc
317 * Yap_WriteBuffer
318 *
319 * Revision 1.45 2004/05/14 17:11:30 vsc
320 * support BigNums in interface
321 *
322 * Revision 1.44 2004/05/14 16:33:44 vsc
323 * add Yap_ReadBuffer
324 * *
325 * *
326 *************************************************************************/
327
328 #define Bool int
329 #define flt double
330 #define YAP_Term Term
331 #define C_INTERFACE
332
333 #include <stdlib.h>
334 #include "Yap.h"
335 #include "clause.h"
336 #include "yapio.h"
337 #include "attvar.h"
338 #if HAVE_STDARG_H
339 #include <stdarg.h>
340 #endif
341 #if HAVE_STRING_H
342 #include <string.h>
343 #endif
344 #if _MSC_VER || defined(__MINGW32__)
345 #include <windows.h>
346 #endif
347 #include "iopreds.h"
348 #define HAS_YAP_H 1
349 #include "yap_structs.h"
350 #ifdef TABLING
351 #include "tab.macros.h"
352 #endif /* TABLING */
353 #ifdef YAPOR
354 #include "or.macros.h"
355 #endif /* YAPOR */
356 #include "threads.h"
357 #ifdef CUT_C
358 #include "cut_c.h"
359 #endif /* CUT_C */
360 #if HAVE_MALLOC_H
361 #include <malloc.h>
362 #endif
363
364 #if !HAVE_STRNCPY
365 #define strncpy(X,Y,Z) strcpy(X,Y)
366 #endif
367 #if !HAVE_STRNCAT
368 #define strncat(X,Y,Z) strcat(X,Y)
369 #endif
370
371 #if defined(_MSC_VER) && defined(YAP_EXPORTS)
372 #define X_API __declspec(dllexport)
373 #else
374 #define X_API
375 #endif
376
377 X_API Term STD_PROTO(YAP_A,(int));
378 X_API Term STD_PROTO(YAP_Deref,(Term));
379 X_API Term STD_PROTO(YAP_MkVarTerm,(void));
380 X_API Bool STD_PROTO(YAP_IsVarTerm,(Term));
381 X_API Bool STD_PROTO(YAP_IsNonVarTerm,(Term));
382 X_API Bool STD_PROTO(YAP_IsIntTerm,(Term));
383 X_API Bool STD_PROTO(YAP_IsLongIntTerm,(Term));
384 X_API Bool STD_PROTO(YAP_IsBigNumTerm,(Term));
385 X_API Bool STD_PROTO(YAP_IsFloatTerm,(Term));
386 X_API Bool STD_PROTO(YAP_IsDbRefTerm,(Term));
387 X_API Bool STD_PROTO(YAP_IsAtomTerm,(Term));
388 X_API Bool STD_PROTO(YAP_IsPairTerm,(Term));
389 X_API Bool STD_PROTO(YAP_IsApplTerm,(Term));
390 X_API Term STD_PROTO(YAP_MkIntTerm,(Int));
391 X_API Term STD_PROTO(YAP_MkBigNumTerm,(void *));
392 X_API Int STD_PROTO(YAP_IntOfTerm,(Term));
393 X_API void STD_PROTO(YAP_BigNumOfTerm,(Term, void *));
394 X_API Term STD_PROTO(YAP_MkFloatTerm,(flt));
395 X_API flt STD_PROTO(YAP_FloatOfTerm,(Term));
396 X_API Term STD_PROTO(YAP_MkAtomTerm,(Atom));
397 X_API Atom STD_PROTO(YAP_AtomOfTerm,(Term));
398 X_API Atom STD_PROTO(YAP_LookupAtom,(char *));
399 X_API Atom STD_PROTO(YAP_LookupWideAtom,(wchar_t *));
400 X_API int STD_PROTO(YAP_AtomNameLength,(Atom));
401 X_API Atom STD_PROTO(YAP_FullLookupAtom,(char *));
402 X_API int STD_PROTO(YAP_IsWideAtom,(Atom));
403 X_API char *STD_PROTO(YAP_AtomName,(Atom));
404 X_API wchar_t *STD_PROTO(YAP_WideAtomName,(Atom));
405 X_API Term STD_PROTO(YAP_MkPairTerm,(Term,Term));
406 X_API Term STD_PROTO(YAP_MkNewPairTerm,(void));
407 X_API Term STD_PROTO(YAP_HeadOfTerm,(Term));
408 X_API Term STD_PROTO(YAP_TailOfTerm,(Term));
409 X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,UInt,Term *));
410 X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,UInt));
411 X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term));
412 X_API Term STD_PROTO(YAP_ArgOfTerm,(Int,Term));
413 X_API Term *STD_PROTO(YAP_ArgsOfTerm,(Term));
414 X_API Functor STD_PROTO(YAP_MkFunctor,(Atom,Int));
415 X_API Atom STD_PROTO(YAP_NameOfFunctor,(Functor));
416 X_API Int STD_PROTO(YAP_ArityOfFunctor,(Functor));
417 X_API void *STD_PROTO(YAP_ExtraSpace,(void));
418 X_API void STD_PROTO(YAP_cut_up,(void));
419 X_API Int STD_PROTO(YAP_Unify,(Term,Term));
420 X_API int STD_PROTO(YAP_Reset,(void));
421 X_API Int STD_PROTO(YAP_Init,(YAP_init_args *));
422 X_API Int STD_PROTO(YAP_FastInit,(char *));
423 X_API PredEntry *STD_PROTO(YAP_FunctorToPred,(Functor));
424 X_API PredEntry *STD_PROTO(YAP_AtomToPred,(Atom));
425 X_API Int STD_PROTO(YAP_CallProlog,(Term));
426 X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
427 X_API void *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
428 X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
429 X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
430 X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *));
431 X_API Term STD_PROTO(YAP_BufferToString, (char *));
432 X_API Term STD_PROTO(YAP_NBufferToString, (char *, size_t));
433 X_API Term STD_PROTO(YAP_WideBufferToString, (wchar_t *));
434 X_API Term STD_PROTO(YAP_NWideBufferToString, (wchar_t *, size_t));
435 X_API Term STD_PROTO(YAP_BufferToAtomList, (char *));
436 X_API Term STD_PROTO(YAP_NBufferToAtomList, (char *,size_t));
437 X_API Term STD_PROTO(YAP_WideBufferToAtomList, (wchar_t *));
438 X_API Term STD_PROTO(YAP_NWideBufferToAtomList, (wchar_t *, size_t));
439 X_API Term STD_PROTO(YAP_NWideBufferToAtomDiffList, (wchar_t *, Term, size_t));
440 X_API Term STD_PROTO(YAP_BufferToDiffList, (char *, Term));
441 X_API Term STD_PROTO(YAP_NBufferToDiffList, (char *, Term, size_t));
442 X_API Term STD_PROTO(YAP_WideBufferToDiffList, (wchar_t *, Term));
443 X_API Term STD_PROTO(YAP_NWideBufferToDiffList, (wchar_t *, Term, size_t));
444 X_API void STD_PROTO(YAP_Error,(int, Term, char *, ...));
445 X_API Term STD_PROTO(YAP_RunGoal,(Term));
446 X_API Term STD_PROTO(YAP_RunGoalOnce,(Term));
447 X_API int STD_PROTO(YAP_RestartGoal,(void));
448 X_API int STD_PROTO(YAP_ShutdownGoal,(int));
449 X_API int STD_PROTO(YAP_EnterGoal,(PredEntry *, Term *, YAP_dogoalinfo *));
450 X_API int STD_PROTO(YAP_RetryGoal,(YAP_dogoalinfo *));
451 X_API int STD_PROTO(YAP_LeaveGoal,(int, YAP_dogoalinfo *));
452 X_API int STD_PROTO(YAP_GoalHasException,(Term *));
453 X_API void STD_PROTO(YAP_ClearExceptions,(void));
454 X_API int STD_PROTO(YAP_ContinueGoal,(void));
455 X_API void STD_PROTO(YAP_PruneGoal,(void));
456 X_API void STD_PROTO(YAP_InitConsult,(int, char *));
457 X_API void STD_PROTO(YAP_EndConsult,(void));
458 X_API Term STD_PROTO(YAP_Read, (int (*)(void)));
459 X_API void STD_PROTO(YAP_Write, (Term, int (*)(wchar_t), int));
460 X_API Term STD_PROTO(YAP_CopyTerm, (Term));
461 X_API Term STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned int, int));
462 X_API char *STD_PROTO(YAP_CompileClause, (Term));
463 X_API void STD_PROTO(YAP_PutValue, (Atom,Term));
464 X_API Term STD_PROTO(YAP_GetValue, (Atom));
465 X_API int STD_PROTO(YAP_CompareTerms, (Term,Term));
466 X_API void STD_PROTO(YAP_Exit, (int));
467 X_API void STD_PROTO(YAP_InitSocks, (char *, long));
468 X_API void STD_PROTO(YAP_SetOutputMessage, (void));
469 X_API int STD_PROTO(YAP_StreamToFileNo, (Term));
470 X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void));
471 X_API void STD_PROTO(YAP_FlushAllStreams,(void));
472 X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int));
473 X_API Int STD_PROTO(YAP_CurrentSlot,(void));
474 X_API Int STD_PROTO(YAP_NewSlots,(int));
475 X_API Int STD_PROTO(YAP_InitSlot,(Term));
476 X_API Term STD_PROTO(YAP_GetFromSlot,(Int));
477 X_API Term *STD_PROTO(YAP_AddressFromSlot,(Int));
478 X_API void STD_PROTO(YAP_PutInSlot,(Int, Term));
479 X_API int STD_PROTO(YAP_RecoverSlots,(int));
480 X_API Int STD_PROTO(YAP_ArgsToSlots,(int));
481 X_API void STD_PROTO(YAP_SlotsToArgs,(int, Int));
482 X_API void STD_PROTO(YAP_Throw,(Term));
483 X_API void STD_PROTO(YAP_AsyncThrow,(Term));
484 X_API void STD_PROTO(YAP_Halt,(int));
485 X_API Term *STD_PROTO(YAP_TopOfLocalStack,(void));
486 X_API void *STD_PROTO(YAP_Predicate,(Atom,UInt,Term));
487 X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,UInt *,Term *));
488 X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,UInt));
489 X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,UInt,unsigned int));
490 X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,UInt,Term));
491 #ifdef CUT_C
492 X_API void STD_PROTO(YAP_UserBackCutCPredicate,(char *,CPredicate,CPredicate,CPredicate,UInt,unsigned int));
493 X_API void *STD_PROTO(YAP_ExtraSpaceCut,(void));
494 #endif
495 X_API Term STD_PROTO(YAP_CurrentModule,(void));
496 X_API Term STD_PROTO(YAP_CreateModule,(Atom));
497 X_API Term STD_PROTO(YAP_StripModule,(Term, Term *));
498 X_API int STD_PROTO(YAP_ThreadSelf,(void));
499 X_API int STD_PROTO(YAP_ThreadCreateEngine,(struct thread_attr_struct *));
500 X_API int STD_PROTO(YAP_ThreadAttachEngine,(int));
501 X_API int STD_PROTO(YAP_ThreadDetachEngine,(int));
502 X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int));
503 X_API Term STD_PROTO(YAP_MkBlobTerm,(unsigned int));
504 X_API void *STD_PROTO(YAP_BlobOfTerm,(Term));
505 X_API Term STD_PROTO(YAP_TermNil,(void));
506 X_API int STD_PROTO(YAP_AtomGetHold,(Atom));
507 X_API int STD_PROTO(YAP_AtomReleaseHold,(Atom));
508 X_API Agc_hook STD_PROTO(YAP_AGCRegisterHook,(Agc_hook));
509 X_API int STD_PROTO(YAP_HaltRegisterHook,(HaltHookFunc, void *));
510 X_API char *STD_PROTO(YAP_cwd,(void));
511 X_API Term STD_PROTO(YAP_OpenList,(int));
512 X_API Term STD_PROTO(YAP_ExtendList,(Term, Term));
513 X_API int STD_PROTO(YAP_CloseList,(Term, Term));
514 X_API int STD_PROTO(YAP_IsAttVar,(Term));
515 X_API Term STD_PROTO(YAP_AttsOfVar,(Term));
516 X_API int STD_PROTO(YAP_FileNoFromStream,(Term));
517 X_API void *STD_PROTO(YAP_FileDescriptorFromStream,(Term));
518 X_API void *STD_PROTO(YAP_Record,(Term));
519 X_API Term STD_PROTO(YAP_Recorded,(void *));
520 X_API int STD_PROTO(YAP_Erase,(void *));
521 X_API int STD_PROTO(YAP_Variant,(Term, Term));
522 X_API int STD_PROTO(YAP_ExactlyEqual,(Term, Term));
523 X_API Int STD_PROTO(YAP_TermHash,(Term, Int, Int, int));
524 X_API int STD_PROTO(YAP_SetYAPFlag,(yap_flag_t, int));
525
526 static int (*do_getf)(void);
527
do_yap_getc(int streamno)528 static int do_yap_getc(int streamno) {
529 return(do_getf());
530 }
531
532 static int (*do_putcf)(wchar_t);
533
do_yap_putc(int streamno,wchar_t ch)534 static int do_yap_putc(int streamno,wchar_t ch) {
535 do_putcf(ch);
536 return(ch);
537 }
538
539 static int
dogc(void)540 dogc(void)
541 {
542 UInt arity;
543 yamop *nextpc;
544
545 if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
546 arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
547 nextpc = P;
548 } else {
549 arity = 0;
550 nextpc = CP;
551 }
552 if (!Yap_gc(arity, ENV, nextpc)) {
553 return FALSE;
554 }
555 return TRUE;
556 }
557
558 static int
doexpand(UInt sz)559 doexpand(UInt sz)
560 {
561 UInt arity;
562
563 if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
564 arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
565 } else {
566 arity = 0;
567 }
568 if (!Yap_gcl(sz, arity, ENV, gc_P(P,CP))) {
569 return FALSE;
570 }
571 return TRUE;
572 }
573
574 X_API Term
YAP_A(int i)575 YAP_A(int i)
576 {
577 return(Deref(XREGS[i]));
578 }
579
580 X_API Term
YAP_Deref(Term t)581 YAP_Deref(Term t)
582 {
583 return(Deref(t));
584 }
585
586 X_API Bool
YAP_IsIntTerm(Term t)587 YAP_IsIntTerm(Term t)
588 {
589 return IsIntegerTerm(t);
590 }
591
592 X_API Bool
YAP_IsLongIntTerm(Term t)593 YAP_IsLongIntTerm(Term t)
594 {
595 return IsLongIntTerm(t);
596 }
597
598 X_API Bool
YAP_IsBigNumTerm(Term t)599 YAP_IsBigNumTerm(Term t)
600 {
601 #if USE_GMP
602 return IsBigIntTerm(t);
603 #else
604 return FALSE;
605 #endif
606 }
607
608 X_API Bool
YAP_IsVarTerm(Term t)609 YAP_IsVarTerm(Term t)
610 {
611 return (IsVarTerm(t));
612 }
613
614 X_API Bool
YAP_IsNonVarTerm(Term t)615 YAP_IsNonVarTerm(Term t)
616 {
617 return (IsNonVarTerm(t));
618 }
619
620 X_API Bool
YAP_IsFloatTerm(Term t)621 YAP_IsFloatTerm(Term t)
622 {
623 return (IsFloatTerm(t));
624 }
625
626 X_API Bool
YAP_IsDbRefTerm(Term t)627 YAP_IsDbRefTerm(Term t)
628 {
629 return (IsDBRefTerm(t));
630 }
631
632 X_API Bool
YAP_IsAtomTerm(Term t)633 YAP_IsAtomTerm(Term t)
634 {
635 return (IsAtomTerm(t));
636 }
637
638 X_API Bool
YAP_IsPairTerm(Term t)639 YAP_IsPairTerm(Term t)
640 {
641 return (IsPairTerm(t));
642 }
643
644 X_API Bool
YAP_IsApplTerm(Term t)645 YAP_IsApplTerm(Term t)
646 {
647 return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)));
648 }
649
650
651 X_API Term
YAP_MkIntTerm(Int n)652 YAP_MkIntTerm(Int n)
653 {
654 Term I;
655 BACKUP_H();
656
657 I = MkIntegerTerm(n);
658 RECOVER_H();
659 return I;
660 }
661
662 X_API Int
YAP_IntOfTerm(Term t)663 YAP_IntOfTerm(Term t)
664 {
665 if (!IsApplTerm(t))
666 return IntOfTerm(t);
667 else {
668 return LongIntOfTerm(t);
669 }
670 }
671
672 X_API Term
YAP_MkBigNumTerm(void * big)673 YAP_MkBigNumTerm(void *big)
674 {
675 #if USE_GMP
676 Term I;
677 BACKUP_H();
678 I = Yap_MkBigIntTerm((MP_INT *)big);
679 RECOVER_H();
680 return I;
681 #else
682 return TermNil;
683 #endif /* USE_GMP */
684 }
685
686 X_API void
YAP_BigNumOfTerm(Term t,void * b)687 YAP_BigNumOfTerm(Term t, void *b)
688 {
689 #if USE_GMP
690 MP_INT *bz = (MP_INT *)b;
691 if (IsVarTerm(t))
692 return;
693 if (!IsBigIntTerm(t))
694 return;
695 mpz_set(bz,Yap_BigIntOfTerm(t));
696 #endif /* USE_GMP */
697 }
698
699 X_API Term
YAP_MkBlobTerm(unsigned int sz)700 YAP_MkBlobTerm(unsigned int sz)
701 {
702 Term I;
703 MP_INT *dst;
704 BACKUP_H();
705
706 while (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) {
707 if (!doexpand((sz+sizeof(MP_INT)/sizeof(CELL)+2)*sizeof(CELL))) {
708 Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", Yap_ErrorMessage);
709 return TermNil;
710 }
711 }
712 I = AbsAppl(H);
713 H[0] = (CELL)FunctorBigInt;
714 H[1] = ARRAY_INT;
715 dst = (MP_INT *)(H+2);
716 dst->_mp_size = 0L;
717 dst->_mp_alloc = sz;
718 H += (2+sizeof(MP_INT)/sizeof(CELL));
719 H[sz] = EndSpecials;
720 H += sz+1;
721 RECOVER_H();
722
723 return I;
724 }
725
726 X_API void *
YAP_BlobOfTerm(Term t)727 YAP_BlobOfTerm(Term t)
728 {
729 MP_INT *src;
730
731 if (IsVarTerm(t))
732 return NULL;
733 if (!IsBigIntTerm(t))
734 return NULL;
735 src = (MP_INT *)(RepAppl(t)+2);
736 return (void *)(src+1);
737 }
738
739 X_API Term
YAP_MkFloatTerm(double n)740 YAP_MkFloatTerm(double n)
741 {
742 Term t;
743 BACKUP_H();
744
745 t = MkFloatTerm(n);
746
747 RECOVER_H();
748 return t;
749 }
750
751 X_API flt
YAP_FloatOfTerm(Term t)752 YAP_FloatOfTerm(Term t)
753 {
754 return (FloatOfTerm(t));
755 }
756
757 X_API Term
YAP_MkAtomTerm(Atom n)758 YAP_MkAtomTerm(Atom n)
759 {
760 Term t;
761
762 t = MkAtomTerm(n);
763 return t;
764 }
765
766 X_API Atom
YAP_AtomOfTerm(Term t)767 YAP_AtomOfTerm(Term t)
768 {
769 return (AtomOfTerm(t));
770 }
771
772
773 X_API int
YAP_IsWideAtom(Atom a)774 YAP_IsWideAtom(Atom a)
775 {
776 return IsWideAtom(a);
777 }
778
779 X_API char *
YAP_AtomName(Atom a)780 YAP_AtomName(Atom a)
781 {
782 char *o;
783
784 o = AtomName(a);
785 return(o);
786 }
787
788 X_API wchar_t *
YAP_WideAtomName(Atom a)789 YAP_WideAtomName(Atom a)
790 {
791 return RepAtom(a)->WStrOfAE;
792 }
793
794 X_API Atom
YAP_LookupAtom(char * c)795 YAP_LookupAtom(char *c)
796 {
797 Atom a;
798
799 while (TRUE) {
800 a = Yap_LookupAtom(c);
801 if (a == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
802 if (!Yap_growheap(FALSE, 0, NULL)) {
803 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
804 }
805 } else {
806 return a;
807 }
808 }
809 }
810
811 X_API Atom
YAP_LookupWideAtom(wchar_t * c)812 YAP_LookupWideAtom(wchar_t *c)
813 {
814 Atom a;
815
816 while (TRUE) {
817 a = Yap_LookupWideAtom(c);
818 if (a == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
819 if (!Yap_growheap(FALSE, 0, NULL)) {
820 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
821 }
822 } else {
823 return a;
824 }
825 }
826 }
827
828 X_API Atom
YAP_FullLookupAtom(char * c)829 YAP_FullLookupAtom(char *c)
830 {
831 Atom at;
832
833 while (TRUE) {
834 at = Yap_FullLookupAtom(c);
835 if (at == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
836 if (!Yap_growheap(FALSE, 0, NULL)) {
837 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
838 }
839 } else {
840 return at;
841 }
842 }
843 }
844
845 X_API int
YAP_AtomNameLength(Atom at)846 YAP_AtomNameLength(Atom at)
847 {
848 if (IsWideAtom(at)) {
849 wchar_t *c = RepAtom(at)->WStrOfAE;
850
851 return wcslen(c);
852 } else {
853 char *c = RepAtom(at)->StrOfAE;
854
855 return strlen(c);
856 }
857 }
858
859 X_API Term
YAP_MkVarTerm(void)860 YAP_MkVarTerm(void)
861 {
862 CELL t;
863 BACKUP_H();
864
865 t = MkVarTerm();
866
867 RECOVER_H();
868 return t;
869 }
870
871 X_API Term
YAP_MkPairTerm(Term t1,Term t2)872 YAP_MkPairTerm(Term t1, Term t2)
873 {
874 Term t;
875 BACKUP_H();
876
877 if (H > ASP-1024) {
878 Int sl1 = Yap_InitSlot(t1);
879 Int sl2 = Yap_InitSlot(t2);
880 if (!dogc()) {
881 RECOVER_H();
882 return TermNil;
883 }
884 t1 = Yap_GetFromSlot(sl1);
885 t2 = Yap_GetFromSlot(sl2);
886 Yap_RecoverSlots(2);
887 }
888 t = MkPairTerm(t1, t2);
889 RECOVER_H();
890 return t;
891 }
892
893 X_API Term
YAP_MkNewPairTerm()894 YAP_MkNewPairTerm()
895 {
896 Term t;
897 BACKUP_H();
898
899 if (H > ASP-1024)
900 t = TermNil;
901 else
902 t = Yap_MkNewPairTerm();
903
904 RECOVER_H();
905 return t;
906 }
907
908 X_API Term
YAP_HeadOfTerm(Term t)909 YAP_HeadOfTerm(Term t)
910 {
911 return (HeadOfTerm(t));
912 }
913
914 X_API Term
YAP_TailOfTerm(Term t)915 YAP_TailOfTerm(Term t)
916 {
917 return (TailOfTerm(t));
918 }
919
920 X_API Term
YAP_MkApplTerm(Functor f,UInt arity,Term args[])921 YAP_MkApplTerm(Functor f,UInt arity, Term args[])
922 {
923 Term t;
924 BACKUP_H();
925
926 if (H+arity > ASP-1024)
927 t = TermNil;
928 else
929 t = Yap_MkApplTerm(f, arity, args);
930
931 RECOVER_H();
932 return t;
933 }
934
935 X_API Term
YAP_MkNewApplTerm(Functor f,UInt arity)936 YAP_MkNewApplTerm(Functor f,UInt arity)
937 {
938 Term t;
939 BACKUP_H();
940
941 if (H+arity > ASP-1024)
942 t = TermNil;
943 else
944 t = Yap_MkNewApplTerm(f, arity);
945
946 RECOVER_H();
947 return t;
948 }
949
950 X_API Functor
YAP_FunctorOfTerm(Term t)951 YAP_FunctorOfTerm(Term t)
952 {
953 return (FunctorOfTerm(t));
954 }
955
956
957 X_API Term
YAP_ArgOfTerm(Int n,Term t)958 YAP_ArgOfTerm(Int n, Term t)
959 {
960 return (ArgOfTerm(n, t));
961 }
962
963 X_API Term *
YAP_ArgsOfTerm(Term t)964 YAP_ArgsOfTerm(Term t)
965 {
966 if (IsApplTerm(t))
967 return RepAppl(t)+1;
968 else if (IsPairTerm(t))
969 return RepPair(t);
970 return NULL;
971 }
972
973 X_API Functor
YAP_MkFunctor(Atom a,Int n)974 YAP_MkFunctor(Atom a, Int n)
975 {
976 return (Yap_MkFunctor(a, n));
977 }
978
979 X_API Atom
YAP_NameOfFunctor(Functor f)980 YAP_NameOfFunctor(Functor f)
981 {
982 return (NameOfFunctor(f));
983 }
984
985 X_API Int
YAP_ArityOfFunctor(Functor f)986 YAP_ArityOfFunctor(Functor f)
987 {
988 return (ArityOfFunctor(f));
989 }
990
991 #ifdef CUT_C
992 X_API void *
YAP_ExtraSpaceCut(void)993 YAP_ExtraSpaceCut(void)
994 {
995 void *ptr;
996 BACKUP_B();
997
998 ptr = (void *)(((CELL *)(Yap_REGS.CUT_C_TOP))-(((yamop *)Yap_REGS.CUT_C_TOP->try_userc_cut_yamop)->u.OtapFs.extra));
999
1000 RECOVER_B();
1001 return(ptr);
1002 }
1003 #endif /*CUT_C*/
1004
1005 X_API void *
YAP_ExtraSpace(void)1006 YAP_ExtraSpace(void)
1007 {
1008 void *ptr;
1009 BACKUP_B();
1010 BACKUP_H();
1011
1012 /* find a pointer to extra space allocable */
1013 ptr = (void *)((CELL *)(B+1)+P->u.OtapFs.s);
1014 B->cp_h = H;
1015
1016 RECOVER_H();
1017 RECOVER_B();
1018 return(ptr);
1019 }
1020
1021 X_API void
YAP_cut_up(void)1022 YAP_cut_up(void)
1023 {
1024 BACKUP_B();
1025 #ifdef CUT_C
1026 {
1027 while (POP_CHOICE_POINT(B->cp_b))
1028 {
1029 POP_EXECUTE();
1030 }
1031 }
1032 #endif /* CUT_C */
1033 /* This is complicated: make sure we can restore the ASP
1034 pointer back to where cut_up called it. Slots depend on it. */
1035 if (ENV > B->cp_env) {
1036 ASP = B->cp_env;
1037 Yap_PopSlots();
1038 }
1039 #ifdef YAPOR
1040 {
1041 choiceptr cut_pt;
1042
1043 cut_pt = B->cp_b;
1044 CUT_prune_to(cut_pt);
1045 Yap_TrimTrail();
1046 B = cut_pt;
1047 }
1048 #else
1049 Yap_TrimTrail();
1050 B = B->cp_b; /* cut_fail */
1051 #endif
1052 HB = B->cp_h; /* cut_fail */
1053 RECOVER_B();
1054 }
1055
1056 X_API Int
YAP_Unify(Term t1,Term t2)1057 YAP_Unify(Term t1, Term t2)
1058 {
1059 Int out;
1060 BACKUP_MACHINE_REGS();
1061
1062 out = Yap_unify(t1, t2);
1063
1064 RECOVER_MACHINE_REGS();
1065 return out;
1066 }
1067
1068 /* == */
1069 X_API int
YAP_ExactlyEqual(Term t1,Term t2)1070 YAP_ExactlyEqual(Term t1, Term t2)
1071 {
1072 int out;
1073 BACKUP_MACHINE_REGS();
1074
1075 out = Yap_eq(t1, t2);
1076
1077 RECOVER_MACHINE_REGS();
1078 return out;
1079 }
1080
1081 /* =@= */
1082 X_API int
YAP_Variant(Term t1,Term t2)1083 YAP_Variant(Term t1, Term t2)
1084 {
1085 int out;
1086 BACKUP_MACHINE_REGS();
1087
1088 out = Yap_Variant(Deref(t1), Deref(t2));
1089
1090 RECOVER_MACHINE_REGS();
1091 return out;
1092 }
1093
1094 /* =@= */
1095 X_API Int
YAP_TermHash(Term t,Int sz,Int depth,int variant)1096 YAP_TermHash(Term t, Int sz, Int depth, int variant)
1097 {
1098 Int out;
1099
1100 BACKUP_MACHINE_REGS();
1101
1102 out = Yap_TermHash(t, sz, depth, variant);
1103
1104 RECOVER_MACHINE_REGS();
1105 return out;
1106 }
1107
1108 X_API Int
YAP_CurrentSlot(void)1109 YAP_CurrentSlot(void)
1110 {
1111 return Yap_CurrentSlot();
1112 }
1113
1114 X_API Int
YAP_NewSlots(int n)1115 YAP_NewSlots(int n)
1116 {
1117 return Yap_NewSlots(n);
1118 }
1119
1120 X_API Int
YAP_InitSlot(Term t)1121 YAP_InitSlot(Term t)
1122 {
1123 return Yap_InitSlot(t);
1124 }
1125
1126 X_API int
YAP_RecoverSlots(int n)1127 YAP_RecoverSlots(int n)
1128 {
1129 return Yap_RecoverSlots(n);
1130 }
1131
1132 X_API Term
YAP_GetFromSlot(Int slot)1133 YAP_GetFromSlot(Int slot)
1134 {
1135 return Yap_GetFromSlot(slot);
1136 }
1137
1138 X_API Term *
YAP_AddressFromSlot(Int slot)1139 YAP_AddressFromSlot(Int slot)
1140 {
1141 return Yap_AddressFromSlot(slot);
1142 }
1143
1144 X_API void
YAP_PutInSlot(Int slot,Term t)1145 YAP_PutInSlot(Int slot, Term t)
1146 {
1147 Yap_PutInSlot(slot, t);
1148 }
1149
1150
1151 typedef enum
1152 { FRG_FIRST_CALL = 0, /* Initial call */
1153 FRG_CUTTED = 1, /* Context was cutted */
1154 FRG_REDO = 2 /* Normal redo */
1155 } frg_code;
1156
1157 typedef struct foreign_context
1158 { int * context; /* context value */
1159 frg_code control; /* FRG_* action */
1160 struct PL_local_data *engine; /* invoking engine */
1161 } scontext ;
1162
1163 typedef Int (*CPredicate1)(Int);
1164 typedef Int (*CPredicate2)(Int,Int);
1165 typedef Int (*CPredicate3)(Int,Int,Int);
1166 typedef Int (*CPredicate4)(Int,Int,Int,Int);
1167 typedef Int (*CPredicate5)(Int,Int,Int,Int,Int);
1168 typedef Int (*CPredicate6)(Int,Int,Int,Int,Int,Int);
1169 typedef Int (*CPredicate7)(Int,Int,Int,Int,Int,Int,Int);
1170 typedef Int (*CPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int);
1171 typedef Int (*CPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int);
1172 typedef Int (*CPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int);
1173 typedef Int (*CPredicateV)(Int,Int,struct foreign_context *);
1174
1175 static Int
execute_cargs(PredEntry * pe,CPredicate exec_code)1176 execute_cargs(PredEntry *pe, CPredicate exec_code)
1177 {
1178 switch (pe->ArityOfPE) {
1179 case 0:
1180 {
1181 CPredicate code0 = exec_code;
1182 return ((code0)());
1183 }
1184 case 1:
1185 {
1186 CPredicate1 code1 = (CPredicate1)exec_code;
1187 return ((code1)(Yap_InitSlot(Deref(ARG1))));
1188 }
1189 case 2:
1190 {
1191 CPredicate2 code2 = (CPredicate2)exec_code;
1192 return ((code2)(Yap_InitSlot(Deref(ARG1)),
1193 Yap_InitSlot(Deref(ARG2))));
1194 }
1195 case 3:
1196 {
1197 CPredicate3 code3 = (CPredicate3)exec_code;
1198 return ((code3)(Yap_InitSlot(Deref(ARG1)),
1199 Yap_InitSlot(Deref(ARG2)),
1200 Yap_InitSlot(Deref(ARG3))));
1201 }
1202 case 4:
1203 {
1204 CPredicate4 code4 = (CPredicate4)exec_code;
1205 return ((code4)(Yap_InitSlot(Deref(ARG1)),
1206 Yap_InitSlot(Deref(ARG2)),
1207 Yap_InitSlot(Deref(ARG3)),
1208 Yap_InitSlot(Deref(ARG4))));
1209 }
1210 case 5:
1211 {
1212 CPredicate5 code5 = (CPredicate5)exec_code;
1213 return ((code5)(Yap_InitSlot(Deref(ARG1)),
1214 Yap_InitSlot(Deref(ARG2)),
1215 Yap_InitSlot(Deref(ARG3)),
1216 Yap_InitSlot(Deref(ARG4)),
1217 Yap_InitSlot(Deref(ARG5))));
1218 }
1219 case 6:
1220 {
1221 CPredicate6 code6 = (CPredicate6)exec_code;
1222 return ((code6)(Yap_InitSlot(Deref(ARG1)),
1223 Yap_InitSlot(Deref(ARG2)),
1224 Yap_InitSlot(Deref(ARG3)),
1225 Yap_InitSlot(Deref(ARG4)),
1226 Yap_InitSlot(Deref(ARG5)),
1227 Yap_InitSlot(Deref(ARG6))));
1228 }
1229 case 7:
1230 {
1231 CPredicate7 code7 = (CPredicate7)exec_code;
1232 return ((code7)(Yap_InitSlot(Deref(ARG1)),
1233 Yap_InitSlot(Deref(ARG2)),
1234 Yap_InitSlot(Deref(ARG3)),
1235 Yap_InitSlot(Deref(ARG4)),
1236 Yap_InitSlot(Deref(ARG5)),
1237 Yap_InitSlot(Deref(ARG6)),
1238 Yap_InitSlot(Deref(ARG7))));
1239 }
1240 case 8:
1241 {
1242 CPredicate8 code8 = (CPredicate8)exec_code;
1243 return ((code8)(Yap_InitSlot(Deref(ARG1)),
1244 Yap_InitSlot(Deref(ARG2)),
1245 Yap_InitSlot(Deref(ARG3)),
1246 Yap_InitSlot(Deref(ARG4)),
1247 Yap_InitSlot(Deref(ARG5)),
1248 Yap_InitSlot(Deref(ARG6)),
1249 Yap_InitSlot(Deref(ARG7)),
1250 Yap_InitSlot(Deref(ARG8))));
1251 }
1252 case 9:
1253 {
1254 CPredicate9 code9 = (CPredicate9)exec_code;
1255 return ((code9)(Yap_InitSlot(Deref(ARG1)),
1256 Yap_InitSlot(Deref(ARG2)),
1257 Yap_InitSlot(Deref(ARG3)),
1258 Yap_InitSlot(Deref(ARG4)),
1259 Yap_InitSlot(Deref(ARG5)),
1260 Yap_InitSlot(Deref(ARG6)),
1261 Yap_InitSlot(Deref(ARG7)),
1262 Yap_InitSlot(Deref(ARG8)),
1263 Yap_InitSlot(Deref(ARG9))));
1264 }
1265 case 10:
1266 {
1267 CPredicate10 code10 = (CPredicate10)exec_code;
1268 return ((code10)(Yap_InitSlot(Deref(ARG1)),
1269 Yap_InitSlot(Deref(ARG2)),
1270 Yap_InitSlot(Deref(ARG3)),
1271 Yap_InitSlot(Deref(ARG4)),
1272 Yap_InitSlot(Deref(ARG5)),
1273 Yap_InitSlot(Deref(ARG6)),
1274 Yap_InitSlot(Deref(ARG7)),
1275 Yap_InitSlot(Deref(ARG8)),
1276 Yap_InitSlot(Deref(ARG9)),
1277 Yap_InitSlot(Deref(ARG10))));
1278 }
1279 default:
1280 return(FALSE);
1281 }
1282 }
1283
1284 typedef Int (*CBPredicate)(struct foreign_context *);
1285 typedef Int (*CBPredicate1)(Int,struct foreign_context *);
1286 typedef Int (*CBPredicate2)(Int,Int,struct foreign_context *);
1287 typedef Int (*CBPredicate3)(Int,Int,Int,struct foreign_context *);
1288 typedef Int (*CBPredicate4)(Int,Int,Int,Int,struct foreign_context *);
1289 typedef Int (*CBPredicate5)(Int,Int,Int,Int,Int,struct foreign_context *);
1290 typedef Int (*CBPredicate6)(Int,Int,Int,Int,Int,Int,struct foreign_context *);
1291 typedef Int (*CBPredicate7)(Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
1292 typedef Int (*CBPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
1293 typedef Int (*CBPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
1294 typedef Int (*CBPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
1295
1296 static Int
execute_cargs_back(PredEntry * pe,CPredicate exec_code,struct foreign_context * ctx)1297 execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx)
1298 {
1299 switch (pe->ArityOfPE) {
1300 case 0:
1301 {
1302 CBPredicate code0 = (CBPredicate)exec_code;
1303 return ((code0)(ctx));
1304 }
1305 case 1:
1306 {
1307 CBPredicate1 code1 = (CBPredicate1)exec_code;
1308 return ((code1)(Yap_InitSlot(Deref(ARG1)),
1309 ctx));
1310 }
1311 case 2:
1312 {
1313 CBPredicate2 code2 = (CBPredicate2)exec_code;
1314 return ((code2)(Yap_InitSlot(Deref(ARG1)),
1315 Yap_InitSlot(Deref(ARG2)),
1316 ctx));
1317 }
1318 case 3:
1319 {
1320 CBPredicate3 code3 = (CBPredicate3)exec_code;
1321 return ((code3)(Yap_InitSlot(Deref(ARG1)),
1322 Yap_InitSlot(Deref(ARG2)),
1323 Yap_InitSlot(Deref(ARG3)),
1324 ctx));
1325 }
1326 case 4:
1327 {
1328 CBPredicate4 code4 = (CBPredicate4)exec_code;
1329 return ((code4)(Yap_InitSlot(Deref(ARG1)),
1330 Yap_InitSlot(Deref(ARG2)),
1331 Yap_InitSlot(Deref(ARG3)),
1332 Yap_InitSlot(Deref(ARG4)),
1333 ctx));
1334 }
1335 case 5:
1336 {
1337 CBPredicate5 code5 = (CBPredicate5)exec_code;
1338 return ((code5)(Yap_InitSlot(Deref(ARG1)),
1339 Yap_InitSlot(Deref(ARG2)),
1340 Yap_InitSlot(Deref(ARG3)),
1341 Yap_InitSlot(Deref(ARG4)),
1342 Yap_InitSlot(Deref(ARG5)), ctx));
1343 }
1344 case 6:
1345 {
1346 CBPredicate6 code6 = (CBPredicate6)exec_code;
1347 return ((code6)(Yap_InitSlot(Deref(ARG1)),
1348 Yap_InitSlot(Deref(ARG2)),
1349 Yap_InitSlot(Deref(ARG3)),
1350 Yap_InitSlot(Deref(ARG4)),
1351 Yap_InitSlot(Deref(ARG5)),
1352 Yap_InitSlot(Deref(ARG6)),
1353 ctx));
1354 }
1355 case 7:
1356 {
1357 CBPredicate7 code7 = (CBPredicate7)exec_code;
1358 return ((code7)(Yap_InitSlot(Deref(ARG1)),
1359 Yap_InitSlot(Deref(ARG2)),
1360 Yap_InitSlot(Deref(ARG3)),
1361 Yap_InitSlot(Deref(ARG4)),
1362 Yap_InitSlot(Deref(ARG5)),
1363 Yap_InitSlot(Deref(ARG6)),
1364 Yap_InitSlot(Deref(ARG7)),
1365 ctx));
1366 }
1367 case 8:
1368 {
1369 CBPredicate8 code8 = (CBPredicate8)exec_code;
1370 return ((code8)(Yap_InitSlot(Deref(ARG1)),
1371 Yap_InitSlot(Deref(ARG2)),
1372 Yap_InitSlot(Deref(ARG3)),
1373 Yap_InitSlot(Deref(ARG4)),
1374 Yap_InitSlot(Deref(ARG5)),
1375 Yap_InitSlot(Deref(ARG6)),
1376 Yap_InitSlot(Deref(ARG7)),
1377 Yap_InitSlot(Deref(ARG8)),
1378 ctx));
1379 }
1380 case 9:
1381 {
1382 CBPredicate9 code9 = (CBPredicate9)exec_code;
1383 return ((code9)(Yap_InitSlot(Deref(ARG1)),
1384 Yap_InitSlot(Deref(ARG2)),
1385 Yap_InitSlot(Deref(ARG3)),
1386 Yap_InitSlot(Deref(ARG4)),
1387 Yap_InitSlot(Deref(ARG5)),
1388 Yap_InitSlot(Deref(ARG6)),
1389 Yap_InitSlot(Deref(ARG7)),
1390 Yap_InitSlot(Deref(ARG8)),
1391 Yap_InitSlot(Deref(ARG9)),
1392 ctx));
1393 }
1394 case 10:
1395 {
1396 CBPredicate10 code10 = (CBPredicate10)exec_code;
1397 return ((code10)(Yap_InitSlot(Deref(ARG1)),
1398 Yap_InitSlot(Deref(ARG2)),
1399 Yap_InitSlot(Deref(ARG3)),
1400 Yap_InitSlot(Deref(ARG4)),
1401 Yap_InitSlot(Deref(ARG5)),
1402 Yap_InitSlot(Deref(ARG6)),
1403 Yap_InitSlot(Deref(ARG7)),
1404 Yap_InitSlot(Deref(ARG8)),
1405 Yap_InitSlot(Deref(ARG9)),
1406 Yap_InitSlot(Deref(ARG10)),
1407 ctx));
1408 }
1409 default:
1410 return(FALSE);
1411 }
1412 }
1413
1414
1415 Int
YAP_Execute(PredEntry * pe,CPredicate exec_code)1416 YAP_Execute(PredEntry *pe, CPredicate exec_code)
1417 {
1418 if (pe->PredFlags & SWIEnvPredFlag) {
1419 CPredicateV codev = (CPredicateV)exec_code;
1420 struct foreign_context ctx;
1421 UInt i;
1422 Int sl = 0;
1423 ctx.engine = NULL;
1424 for (i=pe->ArityOfPE; i > 0; i--) {
1425 sl = Yap_InitSlot(XREGS[i]);
1426 }
1427 return ((codev)(sl,0,&ctx));
1428 }
1429 if (pe->PredFlags & CArgsPredFlag) {
1430 Int out = execute_cargs(pe, exec_code);
1431 return out;
1432 } else {
1433 return((exec_code)());
1434 }
1435 }
1436
1437 #define FRG_REDO_MASK 0x00000003L
1438 #define FRG_REDO_BITS 2
1439 #define REDO_INT 0x02 /* Returned an integer */
1440 #define REDO_PTR 0x03 /* returned a pointer */
1441
1442 Int
YAP_ExecuteFirst(PredEntry * pe,CPredicate exec_code)1443 YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
1444 {
1445 if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
1446 Int val;
1447 CPredicateV codev = (CPredicateV)exec_code;
1448 struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
1449
1450 ctx->control = FRG_FIRST_CALL;
1451 ctx->engine = NULL; //(PL_local_data *)Yap_regp;
1452 ctx->context = NULL;
1453 if (pe->PredFlags & CArgsPredFlag) {
1454 val = execute_cargs_back(pe, exec_code, ctx);
1455 } else {
1456 val = ((codev)((&ARG1)-LCL0,0,ctx));
1457 }
1458 if (val == 0) {
1459 cut_fail();
1460 } else if (val == 1) { /* TRUE */
1461 cut_succeed();
1462 } else {
1463 /*
1464 if ((val & REDO_PTR) == REDO_PTR)
1465 ctx->context = (int *)(val & ~REDO_PTR);
1466 else
1467 ctx->context = (int *)((val & ~REDO_PTR)>>FRG_REDO_BITS);
1468 */
1469 return TRUE;
1470 }
1471 } else {
1472 return (exec_code)();
1473 }
1474 }
1475
1476
1477 Int
YAP_ExecuteNext(PredEntry * pe,CPredicate exec_code)1478 YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
1479 {
1480 if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
1481 Int val;
1482 CPredicateV codev = (CPredicateV)exec_code;
1483 struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
1484
1485 ctx->control = FRG_REDO;
1486 if (pe->PredFlags & CArgsPredFlag) {
1487 val = execute_cargs_back(pe, exec_code, ctx);
1488 } else {
1489 val = ((codev)((&ARG1)-LCL0,0,ctx));
1490 }
1491 if (val == 0) {
1492 cut_fail();
1493 } else if (val == 1) { /* TRUE */
1494 cut_succeed();
1495 } else {
1496 /*
1497 if ((val & REDO_PTR) == REDO_PTR)
1498 ctx->context = (int *)(val & ~REDO_PTR);
1499 else
1500 ctx->context = (int *)((val & ~REDO_PTR)>>FRG_REDO_BITS);
1501 */
1502 }
1503 return TRUE;
1504 }
1505 return (exec_code)();
1506 }
1507
1508 X_API Int
YAP_CallProlog(Term t)1509 YAP_CallProlog(Term t)
1510 {
1511 Int out;
1512 Term mod = CurrentModule;
1513 BACKUP_MACHINE_REGS();
1514
1515 while (!IsVarTerm(t) &&
1516 IsApplTerm(t) &&
1517 FunctorOfTerm(t) == FunctorModule) {
1518 Term tmod = ArgOfTerm(1,t);
1519 if (IsVarTerm(tmod)) return(FALSE);
1520 if (!IsAtomTerm(tmod)) return(FALSE);
1521 mod = tmod;
1522 t = ArgOfTerm(2,t);
1523 }
1524 out = Yap_execute_goal(t, 0, mod);
1525 RECOVER_MACHINE_REGS();
1526 return(out);
1527 }
1528
1529 X_API void *
YAP_ReallocSpaceFromYap(void * ptr,unsigned int size)1530 YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) {
1531 void *new_ptr;
1532 BACKUP_MACHINE_REGS();
1533 while ((new_ptr = Yap_ReallocCodeSpace(ptr,size)) == NULL) {
1534 if (!Yap_growheap(FALSE, size, NULL)) {
1535 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
1536 return NULL;
1537 }
1538 }
1539 RECOVER_MACHINE_REGS();
1540 return new_ptr;
1541 }
1542 X_API void *
YAP_AllocSpaceFromYap(unsigned int size)1543 YAP_AllocSpaceFromYap(unsigned int size)
1544 {
1545 void *ptr;
1546 BACKUP_MACHINE_REGS();
1547
1548 while ((ptr = Yap_AllocCodeSpace(size)) == NULL) {
1549 if (!Yap_growheap(FALSE, size, NULL)) {
1550 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
1551 return NULL;
1552 }
1553 }
1554 RECOVER_MACHINE_REGS();
1555 return ptr;
1556 }
1557
1558 X_API void
YAP_FreeSpaceFromYap(void * ptr)1559 YAP_FreeSpaceFromYap(void *ptr)
1560 {
1561 Yap_FreeCodeSpace(ptr);
1562 }
1563
1564 /* copy a string to a buffer */
1565 X_API int
YAP_StringToBuffer(Term t,char * buf,unsigned int bufsize)1566 YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
1567 {
1568 unsigned int j = 0;
1569
1570 while (t != TermNil) {
1571 register Term Head;
1572 register Int i;
1573
1574 Head = HeadOfTerm(t);
1575 if (IsVarTerm(Head)) {
1576 Yap_Error(INSTANTIATION_ERROR,Head,"user defined procedure");
1577 return(FALSE);
1578 } else if (!IsIntTerm(Head)) {
1579 Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
1580 return(FALSE);
1581 }
1582 i = IntOfTerm(Head);
1583 if (i < 0 || i > 255) {
1584 Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
1585 return(FALSE);
1586 }
1587 buf[j++] = i;
1588 if (j > bufsize) {
1589 buf[j-1] = '\0';
1590 return(FALSE);
1591 }
1592 t = TailOfTerm(t);
1593 if (IsVarTerm(t)) {
1594 Yap_Error(INSTANTIATION_ERROR,t,"user defined procedure");
1595 return(FALSE);
1596 } else if (!IsPairTerm(t) && t != TermNil) {
1597 Yap_Error(TYPE_ERROR_LIST, t, "user defined procedure");
1598 return(FALSE);
1599 }
1600 }
1601 buf[j] = '\0';
1602 return(TRUE);
1603 }
1604
1605
1606 /* copy a string to a buffer */
1607 X_API Term
YAP_BufferToString(char * s)1608 YAP_BufferToString(char *s)
1609 {
1610 Term t;
1611 BACKUP_H();
1612
1613 t = Yap_StringToList(s);
1614
1615 RECOVER_H();
1616 return t;
1617 }
1618
1619 /* copy a string to a buffer */
1620 X_API Term
YAP_NBufferToString(char * s,size_t len)1621 YAP_NBufferToString(char *s, size_t len)
1622 {
1623 Term t;
1624 BACKUP_H();
1625
1626 t = Yap_NStringToList(s, len);
1627
1628 RECOVER_H();
1629 return t;
1630 }
1631
1632 /* copy a string to a buffer */
1633 X_API Term
YAP_WideBufferToString(wchar_t * s)1634 YAP_WideBufferToString(wchar_t *s)
1635 {
1636 Term t;
1637 BACKUP_H();
1638
1639 t = Yap_WideStringToList(s);
1640
1641 RECOVER_H();
1642 return t;
1643 }
1644
1645 /* copy a string to a buffer */
1646 X_API Term
YAP_NWideBufferToString(wchar_t * s,size_t len)1647 YAP_NWideBufferToString(wchar_t *s, size_t len)
1648 {
1649 Term t;
1650 BACKUP_H();
1651
1652 t = Yap_NWideStringToList(s, len);
1653
1654 RECOVER_H();
1655 return t;
1656 }
1657
1658 /* copy a string to a buffer */
1659 X_API Term
YAP_ReadBuffer(char * s,Term * tp)1660 YAP_ReadBuffer(char *s, Term *tp)
1661 {
1662 Term t;
1663 BACKUP_H();
1664
1665 while ((t = Yap_StringToTerm(s,tp)) == 0L) {
1666 if (Yap_ErrorMessage) {
1667 if (!strcmp(Yap_ErrorMessage,"Stack Overflow")) {
1668 if (!dogc()) {
1669 *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
1670 Yap_ErrorMessage = NULL;
1671 RECOVER_H();
1672 return 0L;
1673 }
1674 } else if (!strcmp(Yap_ErrorMessage,"Heap Overflow")) {
1675 if (!Yap_growheap(FALSE, 0, NULL)) {
1676 *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
1677 Yap_ErrorMessage = NULL;
1678 RECOVER_H();
1679 return 0L;
1680 }
1681 } else if (!strcmp(Yap_ErrorMessage,"Trail Overflow")) {
1682 if (!Yap_growtrail (0, FALSE)) {
1683 *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
1684 Yap_ErrorMessage = NULL;
1685 RECOVER_H();
1686 return 0L;
1687 }
1688 } else {
1689 *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
1690 Yap_ErrorMessage = NULL;
1691 RECOVER_H();
1692 return 0L;
1693 }
1694 Yap_ErrorMessage = NULL;
1695 continue;
1696 } else {
1697 break;
1698 }
1699 }
1700 RECOVER_H();
1701 return t;
1702 }
1703
1704 /* copy a string to a buffer */
1705 X_API Term
YAP_BufferToAtomList(char * s)1706 YAP_BufferToAtomList(char *s)
1707 {
1708 Term t;
1709 BACKUP_H();
1710
1711 t = Yap_StringToListOfAtoms(s);
1712
1713 RECOVER_H();
1714 return t;
1715 }
1716
1717 /* copy a string of size len to a buffer */
1718 X_API Term
YAP_NBufferToAtomList(char * s,size_t len)1719 YAP_NBufferToAtomList(char *s, size_t len)
1720 {
1721 Term t;
1722 BACKUP_H();
1723
1724 t = Yap_NStringToListOfAtoms(s, len);
1725
1726 RECOVER_H();
1727 return t;
1728 }
1729
1730 /* copy a string to a buffer */
1731 X_API Term
YAP_WideBufferToAtomList(wchar_t * s)1732 YAP_WideBufferToAtomList(wchar_t *s)
1733 {
1734 Term t;
1735 BACKUP_H();
1736
1737 t = Yap_WideStringToListOfAtoms(s);
1738
1739 RECOVER_H();
1740 return t;
1741 }
1742
1743 /* copy a string of size len to a buffer */
1744 X_API Term
YAP_NWideBufferToAtomList(wchar_t * s,size_t len)1745 YAP_NWideBufferToAtomList(wchar_t *s, size_t len)
1746 {
1747 Term t;
1748 BACKUP_H();
1749
1750 t = Yap_NWideStringToListOfAtoms(s, len);
1751
1752 RECOVER_H();
1753 return t;
1754 }
1755
1756 /* copy a string of size len to a buffer */
1757 X_API Term
YAP_NWideBufferToAtomDiffList(wchar_t * s,Term t0,size_t len)1758 YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
1759 {
1760 Term t;
1761 BACKUP_H();
1762
1763 t = Yap_NWideStringToDiffListOfAtoms(s, t0, len);
1764
1765 RECOVER_H();
1766 return t;
1767 }
1768
1769 /* copy a string to a buffer */
1770 X_API Term
YAP_BufferToDiffList(char * s,Term t0)1771 YAP_BufferToDiffList(char *s, Term t0)
1772 {
1773 Term t;
1774 BACKUP_H();
1775
1776 t = Yap_StringToDiffList(s, t0);
1777
1778 RECOVER_H();
1779 return t;
1780 }
1781
1782 /* copy a string of size len to a buffer */
1783 X_API Term
YAP_NBufferToDiffList(char * s,Term t0,size_t len)1784 YAP_NBufferToDiffList(char *s, Term t0, size_t len)
1785 {
1786 Term t;
1787 BACKUP_H();
1788
1789 t = Yap_NStringToDiffList(s, t0, len);
1790
1791 RECOVER_H();
1792 return t;
1793 }
1794
1795 /* copy a string to a buffer */
1796 X_API Term
YAP_WideBufferToDiffList(wchar_t * s,Term t0)1797 YAP_WideBufferToDiffList(wchar_t *s, Term t0)
1798 {
1799 Term t;
1800 BACKUP_H();
1801
1802 t = Yap_WideStringToDiffList(s, t0);
1803
1804 RECOVER_H();
1805 return t;
1806 }
1807
1808 /* copy a string of size len to a buffer */
1809 X_API Term
YAP_NWideBufferToDiffList(wchar_t * s,Term t0,size_t len)1810 YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len)
1811 {
1812 Term t;
1813 BACKUP_H();
1814
1815 t = Yap_NWideStringToDiffList(s, t0, len);
1816
1817 RECOVER_H();
1818 return t;
1819 }
1820
1821
1822 X_API void
YAP_Error(int myerrno,Term t,char * buf,...)1823 YAP_Error(int myerrno, Term t, char *buf,...)
1824 {
1825 #define YAP_BUF_SIZE 512
1826 va_list ap;
1827 char tmpbuf[YAP_BUF_SIZE];
1828
1829 if (!myerrno)
1830 myerrno = SYSTEM_ERROR;
1831 if (t == 0L)
1832 t = TermNil;
1833 if (buf != NULL) {
1834 va_start (ap, buf);
1835 #if HAVE_VSNPRINTF
1836 (void) vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap);
1837 #else
1838 (void) vsprintf(tmpbuf, buf, ap);
1839 #endif
1840 va_end (ap);
1841 } else {
1842 tmpbuf[0] = '\0';
1843 }
1844 Yap_Error(myerrno,t,tmpbuf);
1845 }
1846
myputc(wchar_t ch)1847 static int myputc (wchar_t ch)
1848 {
1849 putc(ch,stderr);
1850 return ch;
1851 }
1852
1853 X_API PredEntry *
YAP_FunctorToPred(Functor func)1854 YAP_FunctorToPred(Functor func)
1855 {
1856 return RepPredProp(PredPropByFunc(func, CurrentModule));
1857 }
1858
1859 X_API PredEntry *
YAP_AtomToPred(Atom at)1860 YAP_AtomToPred(Atom at)
1861 {
1862 return RepPredProp(PredPropByAtom(at, CurrentModule));
1863 }
1864
1865
1866 static int
run_emulator(YAP_dogoalinfo * dgi)1867 run_emulator(YAP_dogoalinfo *dgi)
1868 {
1869 choiceptr myB;
1870 int out;
1871 BACKUP_MACHINE_REGS();
1872
1873 Yap_PrologMode = UserMode;
1874 out = Yap_absmi(0);
1875 Yap_PrologMode = UserCCallMode;
1876 myB = (choiceptr)(LCL0-dgi->b);
1877 CP = myB->cp_cp;
1878 if (!out ) {
1879 /* recover stack */
1880 /* on failed computations */
1881 TR = B->cp_tr;
1882 H = B->cp_h;
1883 #ifdef DEPTH_LIMIT
1884 DEPTH = B->cp_depth = DEPTH;
1885 #endif /* DEPTH_LIMIT */
1886 YENV = ENV = B->cp_env;
1887 ASP = (CELL *)(B+1);
1888 Yap_PopSlots();
1889 B = B->cp_b;
1890 HB = B->cp_h;
1891 } else {
1892 Yap_StartSlots();
1893 }
1894 P = dgi->p;
1895 RECOVER_MACHINE_REGS();
1896 return out;
1897 }
1898
1899 X_API int
YAP_EnterGoal(PredEntry * pe,Term * ptr,YAP_dogoalinfo * dgi)1900 YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
1901 {
1902 UInt i;
1903 choiceptr myB;
1904 int out;
1905
1906 BACKUP_MACHINE_REGS();
1907 dgi->p = P;
1908 ptr--;
1909 i = pe->ArityOfPE;
1910 while (i>0) {
1911 XREGS[i] = ptr[i];
1912 i--;
1913 }
1914 P = pe->CodeOfPred;
1915 /* create a choice-point to be tag new goal */
1916 myB = (choiceptr)ASP;
1917 myB--;
1918 dgi->b = LCL0-(CELL *)myB;
1919 myB->cp_tr = TR;
1920 myB->cp_h = HB = H;
1921 myB->cp_b = B;
1922 #ifdef DEPTH_LIMIT
1923 myB->cp_depth = DEPTH;
1924 #endif /* DEPTH_LIMIT */
1925 myB->cp_cp = CP;
1926 myB->cp_ap = NOCODE;
1927 myB->cp_env = ENV;
1928 CP = YESCODE;
1929 B = myB;
1930 HB = H;
1931 #if defined(YAPOR) || defined(THREADS)
1932 WPP = NULL;
1933 #endif
1934 ASP = YENV = (CELL *)B;
1935 Yap_PopSlots();
1936 YENV[E_CB] = Unsigned (B);
1937 out = run_emulator(dgi);
1938 RECOVER_MACHINE_REGS();
1939 return out;
1940 }
1941
1942 X_API int
YAP_RetryGoal(YAP_dogoalinfo * dgi)1943 YAP_RetryGoal(YAP_dogoalinfo *dgi)
1944 {
1945 choiceptr myB;
1946 int out;
1947
1948 BACKUP_MACHINE_REGS();
1949 myB = (choiceptr)(LCL0-dgi->b);
1950 CP = myB->cp_cp;
1951 /* sanity check */
1952 if (B >= myB) {
1953 return FALSE;
1954 }
1955 P = FAILCODE;
1956 out = run_emulator(dgi);
1957 RECOVER_MACHINE_REGS();
1958 return out;
1959 }
1960
1961 X_API int
YAP_LeaveGoal(int backtrack,YAP_dogoalinfo * dgi)1962 YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
1963 {
1964 choiceptr myB;
1965
1966 BACKUP_MACHINE_REGS();
1967 myB = (choiceptr)(LCL0-dgi->b);
1968 if (B > myB) {
1969 /* someone cut us */
1970 return FALSE;
1971 }
1972 /* prune away choicepoints */
1973 if (B != myB) {
1974 #ifdef YAPOR
1975 CUT_prune_to(myB);
1976 #endif
1977 B = myB;
1978 }
1979 /* if backtracking asked for, recover space and bindings */
1980 if (backtrack) {
1981 P = FAILCODE;
1982 Yap_exec_absmi(TRUE);
1983 /* recover stack space */
1984 H = B->cp_h;
1985 TR = B->cp_tr;
1986 #ifdef DEPTH_LIMIT
1987 DEPTH = B->cp_depth;
1988 #endif /* DEPTH_LIMIT */
1989 YENV = ENV = B->cp_env;
1990 } else {
1991 Yap_TrimTrail();
1992 }
1993 /* recover local stack */
1994 ASP = (CELL *)(B+1);
1995 Yap_PopSlots();
1996 B = B->cp_b;
1997 HB = B->cp_h;
1998 P = dgi->p;
1999 RECOVER_MACHINE_REGS();
2000 return TRUE;
2001 }
2002
2003 X_API Term
YAP_RunGoal(Term t)2004 YAP_RunGoal(Term t)
2005 {
2006 Term out;
2007 yamop *old_CP = CP;
2008 BACKUP_MACHINE_REGS();
2009
2010 Yap_AllowRestart = FALSE;
2011 Yap_PrologMode = UserMode;
2012 out = Yap_RunTopGoal(t);
2013 Yap_PrologMode = UserCCallMode;
2014 if (out) {
2015 P = (yamop *)ENV[E_CP];
2016 ENV = (CELL *)ENV[E_E];
2017 CP = old_CP;
2018 Yap_AllowRestart = TRUE;
2019 } else {
2020 ENV = B->cp_env;
2021 B = B->cp_b;
2022 Yap_AllowRestart = FALSE;
2023 }
2024
2025 RECOVER_MACHINE_REGS();
2026 return(out);
2027 }
2028
2029 X_API Term
YAP_RunGoalOnce(Term t)2030 YAP_RunGoalOnce(Term t)
2031 {
2032 Term out;
2033 yamop *old_CP = CP;
2034 BACKUP_MACHINE_REGS();
2035
2036 Yap_PrologMode = UserMode;
2037 out = Yap_RunTopGoal(t);
2038 Yap_PrologMode = UserCCallMode;
2039 if (out) {
2040 choiceptr cut_pt;
2041
2042 cut_pt = B;
2043 while (cut_pt-> cp_ap != NOCODE) {
2044 cut_pt = cut_pt->cp_b;
2045 }
2046 #ifdef YAPOR
2047 CUT_prune_to(cut_pt);
2048 #endif
2049 B = cut_pt;
2050 Yap_TrimTrail();
2051 }
2052 ASP = B->cp_env;
2053 Yap_PopSlots();
2054 ENV = (CELL *)ASP[E_E];
2055 B = (choiceptr)ASP[E_CB];
2056 #ifdef DEPTH_LIMIT
2057 DEPTH = ASP[E_DEPTH];
2058 #endif
2059 P = (yamop *)ASP[E_CP];
2060 CP = old_CP;
2061 Yap_AllowRestart = FALSE;
2062 RECOVER_MACHINE_REGS();
2063 return(out);
2064 }
2065
2066 X_API int
YAP_RestartGoal(void)2067 YAP_RestartGoal(void)
2068 {
2069 int out;
2070 BACKUP_MACHINE_REGS();
2071 if (Yap_AllowRestart) {
2072 P = (yamop *)FAILCODE;
2073 do_putcf = myputc;
2074 Yap_PrologMode = UserMode;
2075 out = Yap_exec_absmi(TRUE);
2076 Yap_PrologMode = UserCCallMode;
2077 if (out == FALSE) {
2078 /* cleanup */
2079 Yap_CloseSlots();
2080 Yap_trust_last();
2081 Yap_AllowRestart = FALSE;
2082 }
2083 } else {
2084 out = FALSE;
2085 }
2086 RECOVER_MACHINE_REGS();
2087 return(out);
2088 }
2089
2090 X_API int
YAP_ShutdownGoal(int backtrack)2091 YAP_ShutdownGoal(int backtrack)
2092 {
2093 BACKUP_MACHINE_REGS();
2094
2095 if (Yap_AllowRestart) {
2096 choiceptr cut_pt;
2097
2098 cut_pt = B;
2099 while (cut_pt-> cp_ap != NOCODE) {
2100 cut_pt = cut_pt->cp_b;
2101 }
2102 #ifdef YAPOR
2103 CUT_prune_to(cut_pt);
2104 #endif
2105 /* just force backtrack */
2106 B = cut_pt;
2107 if (backtrack) {
2108 P = FAILCODE;
2109 Yap_exec_absmi(TRUE);
2110 /* recover stack space */
2111 H = cut_pt->cp_h;
2112 TR = cut_pt->cp_tr;
2113 }
2114 /* we can always recover the stack */
2115 ASP = cut_pt->cp_env;
2116 Yap_PopSlots();
2117 ENV = (CELL *)ASP[E_E];
2118 B = (choiceptr)ASP[E_CB];
2119 Yap_TrimTrail();
2120 #ifdef DEPTH_LIMIT
2121 DEPTH = ASP[E_DEPTH];
2122 #endif
2123 Yap_AllowRestart = FALSE;
2124 }
2125 RECOVER_MACHINE_REGS();
2126 return TRUE;
2127 }
2128
2129 X_API int
YAP_ContinueGoal(void)2130 YAP_ContinueGoal(void)
2131 {
2132 int out;
2133 BACKUP_MACHINE_REGS();
2134
2135 Yap_PrologMode = UserMode;
2136 out = Yap_exec_absmi(TRUE);
2137 Yap_PrologMode = UserCCallMode;
2138
2139 RECOVER_MACHINE_REGS();
2140 return(out);
2141 }
2142
2143 X_API void
YAP_PruneGoal(void)2144 YAP_PruneGoal(void)
2145 {
2146 BACKUP_B();
2147
2148 while (B->cp_ap != NOCODE) {
2149 B = B->cp_b;
2150 }
2151 Yap_TrimTrail();
2152 /* make sure that we do not destroy the guard choice-point */
2153 if (Yap_op_from_opcode(B->cp_ap->opc) != _Nstop)
2154 B = B->cp_b;
2155
2156 RECOVER_B();
2157 }
2158
2159 X_API int
YAP_GoalHasException(Term * t)2160 YAP_GoalHasException(Term *t)
2161 {
2162 int out = FALSE;
2163 BACKUP_MACHINE_REGS();
2164 if (EX) {
2165 do {
2166 Yap_Error_TYPE = YAP_NO_ERROR;
2167 *t = Yap_FetchTermFromDB(EX);
2168 if (Yap_Error_TYPE == YAP_NO_ERROR) {
2169 RECOVER_MACHINE_REGS();
2170 return TRUE;
2171 } else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
2172 Yap_Error_TYPE = YAP_NO_ERROR;
2173 if (!Yap_growglobal(NULL)) {
2174 Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
2175 RECOVER_MACHINE_REGS();
2176 return FALSE;
2177 }
2178 } else {
2179 Yap_Error_TYPE = YAP_NO_ERROR;
2180 if (!Yap_growstack(EX->NOfCells*CellSize)) {
2181 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
2182 RECOVER_MACHINE_REGS();
2183 return FALSE;
2184 }
2185 }
2186 } while (*t == (CELL)0);
2187 out = TRUE;
2188 }
2189 RECOVER_MACHINE_REGS();
2190 return out;
2191 }
2192
2193 X_API void
YAP_ClearExceptions(void)2194 YAP_ClearExceptions(void)
2195 {
2196 Yap_ResetExceptionTerm();
2197 if (EX) {
2198 BallTerm = EX;
2199 }
2200 EX = NULL;
2201 Yap_ResetExceptionTerm();
2202 UncaughtThrow = FALSE;
2203 }
2204
2205 X_API void
YAP_InitConsult(int mode,char * filename)2206 YAP_InitConsult(int mode, char *filename)
2207 {
2208 BACKUP_MACHINE_REGS();
2209
2210 if (mode == YAP_CONSULT_MODE)
2211 Yap_init_consult(FALSE, filename);
2212 else
2213 Yap_init_consult(TRUE, filename);
2214
2215 RECOVER_MACHINE_REGS();
2216 }
2217
2218 X_API void
YAP_EndConsult(void)2219 YAP_EndConsult(void)
2220 {
2221 BACKUP_MACHINE_REGS();
2222
2223 Yap_end_consult();
2224
2225 RECOVER_MACHINE_REGS();
2226 }
2227
2228 X_API Term
YAP_Read(int (* mygetc)(void))2229 YAP_Read(int (*mygetc)(void))
2230 {
2231 Term t, tpos = TermNil;
2232 int sno;
2233 TokEntry *tokstart;
2234
2235 BACKUP_MACHINE_REGS();
2236
2237 do_getf = mygetc;
2238 sno = Yap_GetFreeStreamDForReading();
2239 if (sno < 0) {
2240 Yap_Error(SYSTEM_ERROR,TermNil, "new stream not available for YAP_Read");
2241 return TermNil;
2242 }
2243 Stream[sno].stream_getc = do_yap_getc;
2244 Stream[sno].status |= Tty_Stream_f;
2245 tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
2246 Stream[sno].status = Free_Stream_f;
2247 UNLOCK(Stream[sno].streamlock);
2248 if (Yap_ErrorMessage)
2249 {
2250 Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
2251 RECOVER_MACHINE_REGS();
2252 return 0;
2253 }
2254 t = Yap_Parse();
2255 Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
2256
2257 RECOVER_MACHINE_REGS();
2258 return t;
2259 }
2260
2261 X_API void
YAP_Write(Term t,int (* myputc)(wchar_t),int flags)2262 YAP_Write(Term t, int (*myputc)(wchar_t), int flags)
2263 {
2264 BACKUP_MACHINE_REGS();
2265
2266 do_putcf = myputc; /* */
2267 Yap_plwrite (t, do_yap_putc, flags, 1200);
2268
2269 RECOVER_MACHINE_REGS();
2270 }
2271
2272
2273 X_API Term
YAP_CopyTerm(Term t)2274 YAP_CopyTerm(Term t)
2275 {
2276 Term tn;
2277 BACKUP_MACHINE_REGS();
2278
2279 tn = Yap_CopyTerm(t);
2280
2281 RECOVER_MACHINE_REGS();
2282
2283 return tn;
2284 }
2285
2286 X_API Term
YAP_WriteBuffer(Term t,char * buf,unsigned int sze,int flags)2287 YAP_WriteBuffer(Term t, char *buf, unsigned int sze, int flags)
2288 {
2289 BACKUP_MACHINE_REGS();
2290 t = Yap_TermToString(t, buf, sze, flags);
2291 RECOVER_MACHINE_REGS();
2292 return t;
2293 }
2294
2295 X_API char *
YAP_CompileClause(Term t)2296 YAP_CompileClause(Term t)
2297 {
2298 yamop *codeaddr;
2299 int mod = CurrentModule;
2300 Term tn = TermNil;
2301
2302 BACKUP_MACHINE_REGS();
2303
2304 /* allow expansion during stack initialization */
2305 Yap_ErrorMessage = NULL;
2306 ARG1 = t;
2307 YAPEnterCriticalSection();
2308 codeaddr = Yap_cclause (t,0, mod, t);
2309 if (codeaddr != NULL) {
2310 t = Deref(ARG1); /* just in case there was an heap overflow */
2311 if (!Yap_addclause (t, codeaddr, TRUE, mod, &tn)) {
2312 YAPLeaveCriticalSection();
2313 return Yap_ErrorMessage;
2314 }
2315 }
2316 YAPLeaveCriticalSection();
2317
2318 if (ActiveSignals & YAP_CDOVF_SIGNAL) {
2319 if (!Yap_growheap(FALSE, 0, NULL)) {
2320 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
2321 }
2322 }
2323 RECOVER_MACHINE_REGS();
2324 return(Yap_ErrorMessage);
2325 }
2326
2327 static int eof_found = FALSE;
2328 static int yap_lineno = 0;
2329
2330 static FILE *bootfile;
2331
2332 static char InitFile[] = "init.yap";
2333 static char BootFile[] = "boot.yap";
2334
2335 static int
mygetc(void)2336 mygetc (void)
2337 {
2338 int ch;
2339 if (eof_found)
2340 return EOF;
2341 ch = getc (bootfile);
2342 if (ch == EOF)
2343 eof_found = TRUE;
2344 if (ch == '\n') {
2345 #ifdef MPW
2346 ch = 10;
2347 #endif
2348 yap_lineno++;
2349 }
2350 return ch;
2351 }
2352
2353 /* do initial boot by consulting the file boot.yap */
2354 static void
do_bootfile(char * bootfilename)2355 do_bootfile (char *bootfilename)
2356 {
2357 Term t;
2358 Term term_end_of_file = MkAtomTerm(AtomEof);
2359 Term term_true = YAP_MkAtomTerm(AtomTrue);
2360 Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"),1);
2361
2362 /* consult boot.pl */
2363 bootfile = fopen (bootfilename, "r");
2364 if (bootfile == NULL)
2365 {
2366 fprintf(stderr, "[ FATAL ERROR: could not open bootfile %s ]\n", bootfilename);
2367 exit(1);
2368 }
2369 /* the consult mode does not matter here, really */
2370 /*
2371 To be honest, YAP_InitConsult does not really do much,
2372 it's here for the future. It also makes what we want to do clearer.
2373 */
2374 YAP_InitConsult(YAP_CONSULT_MODE,bootfilename);
2375 while (!eof_found)
2376 {
2377 t = YAP_Read(mygetc);
2378 if (eof_found) {
2379 break;
2380 }
2381 if (t == 0)
2382 {
2383 fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", bootfilename, yap_lineno);
2384 exit(1);
2385 }
2386 if (YAP_IsVarTerm (t) || t == TermNil)
2387 {
2388 continue;
2389 }
2390 else if (t == term_true)
2391 {
2392 YAP_Exit(0);
2393 }
2394 else if (t == term_end_of_file)
2395 {
2396 break;
2397 }
2398 else if (YAP_IsPairTerm (t))
2399 {
2400 fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n");
2401 fprintf(stderr, "error found at line %d and pos %d", yap_lineno, fseek(bootfile,0L,SEEK_CUR));
2402 }
2403 else if (YAP_IsApplTerm (t) && FunctorOfTerm (t) == functor_query)
2404 {
2405 YAP_RunGoalOnce(ArgOfTerm (1, t));
2406 }
2407 else
2408 {
2409 char *ErrorMessage = YAP_CompileClause(t);
2410 if (ErrorMessage)
2411 fprintf(stderr, "%s", ErrorMessage);
2412 }
2413 /* do backtrack */
2414 YAP_Reset();
2415 }
2416 YAP_EndConsult();
2417 fclose (bootfile);
2418 #ifdef DEBUG
2419 if (output_msg)
2420 fprintf(stderr,"Boot loaded\n");
2421 #endif
2422 }
2423
2424 static void
construct_init_file(char * boot_file,char * BootFile)2425 construct_init_file(char *boot_file, char *BootFile)
2426 {
2427 /* trust YAPSHAREDIR over YAP_PL_SRCDIR, and notice that the code is / dependent. */
2428 #if HAVE_GETENV
2429 if (getenv("YAPSHAREDIR")) {
2430 strncpy(boot_file, getenv("YAPSHAREDIR"), 256);
2431 strncat(boot_file, "/pl/", 255);
2432 } else {
2433 #endif
2434 strncpy(boot_file, YAP_PL_SRCDIR, 256);
2435 strncat(boot_file, "/", 255);
2436 #if HAVE_GETENV
2437 }
2438 #endif
2439 strncat(boot_file, BootFile, 255);
2440 }
2441
2442
2443 /* this routine is supposed to be called from an external program
2444 that wants to control Yap */
2445
2446 #if defined(USE_SYSTEM_MALLOC)
2447 #define BOOT_FROM_SAVED_STATE FALSE
2448 #else
2449 #define BOOT_FROM_SAVED_STATE TRUE
2450 #endif
2451
2452 X_API Int
YAP_Init(YAP_init_args * yap_init)2453 YAP_Init(YAP_init_args *yap_init)
2454 {
2455 int restore_result;
2456 int do_bootstrap = (yap_init->YapPrologBootFile != NULL);
2457 CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;
2458 static char boot_file[256];
2459
2460 Yap_argv = yap_init->Argv;
2461 Yap_argc = yap_init->Argc;
2462 #if !BOOT_FROM_SAVED_STATE
2463 if (yap_init->SavedState) {
2464 fprintf(stderr,"[ WARNING: threaded YAP will ignore saved state %s ]\n",yap_init->SavedState);
2465 yap_init->SavedState = NULL;
2466 }
2467 #endif
2468 if (BOOT_FROM_SAVED_STATE && !do_bootstrap) {
2469 if (Yap_SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap) != 1) {
2470 yap_init->ErrorNo = Yap_Error_TYPE;
2471 yap_init->ErrorCause = Yap_ErrorMessage;
2472 return YAP_BOOT_ERROR;
2473 }
2474 }
2475 if (yap_init->TrailSize == 0) {
2476 if (yap_init->MaxTrailSize) {
2477 Trail = yap_init->MaxTrailSize;
2478 } else if (Trail == 0)
2479 Trail = DefTrailSpace;
2480 } else {
2481 Trail = yap_init->TrailSize;
2482 }
2483 Atts = yap_init->AttsSize;
2484 if (yap_init->StackSize == 0) {
2485 if (yap_init->MaxStackSize || yap_init->MaxGlobalSize) {
2486 if (yap_init->MaxStackSize) {
2487 if (yap_init->MaxGlobalSize) {
2488 Stack = yap_init->MaxStackSize+yap_init->MaxGlobalSize;
2489 } else {
2490 Stack = yap_init->MaxStackSize+DefStackSpace/2;
2491 }
2492 } else {
2493 Stack = yap_init->MaxGlobalSize+DefStackSpace/2;
2494 }
2495 } else if (Stack == 0)
2496 Stack = DefStackSpace;
2497 } else {
2498 Stack = yap_init->StackSize;
2499 }
2500 if (yap_init->HeapSize == 0) {
2501 if (Heap == 0)
2502 Heap = DefHeapSpace;
2503 } else {
2504 Heap = yap_init->HeapSize;
2505 }
2506 Yap_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts;
2507 Yap_InitWorkspace(Heap, Stack, Trail, Atts,
2508 yap_init->MaxTableSpaceSize,
2509 yap_init->NumberWorkers,
2510 yap_init->SchedulerLoop,
2511 yap_init->DelayedReleaseLoad
2512 );
2513 #if USE_SYSTEM_MALLOC
2514 if (Trail < MinTrailSpace)
2515 Trail = MinTrailSpace;
2516 if (Stack < MinStackSpace)
2517 Stack = MinStackSpace;
2518 if (!(Yap_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) {
2519 yap_init->ErrorNo = RESOURCE_ERROR_MEMORY;
2520 yap_init->ErrorCause = "could not allocate stack space for main thread";
2521 return YAP_BOOT_ERROR;
2522 }
2523 #if THREADS
2524 /* don't forget this is a thread */
2525 MY_ThreadHandle.stack_address = Yap_GlobalBase;
2526 MY_ThreadHandle.ssize = Trail+Stack;
2527 #endif
2528 #endif
2529 Yap_AllowGlobalExpansion = TRUE;
2530 Yap_AllowLocalExpansion = TRUE;
2531 Yap_AllowTrailExpansion = TRUE;
2532 Yap_InitExStacks (Trail, Stack);
2533 if (yap_init->QuietMode) {
2534 yap_flags[QUIET_MODE_FLAG] = TRUE;
2535 }
2536
2537 { BACKUP_MACHINE_REGS();
2538 Yap_InitYaamRegs();
2539
2540 #if HAVE_MPI
2541 Yap_InitMPI ();
2542 #endif
2543 #if HAVE_MPE
2544 Yap_InitMPE ();
2545 #endif
2546
2547 if (yap_init->YapPrologRCFile != NULL) {
2548 /*
2549 This must be done before restore, otherwise
2550 restore will print out messages ....
2551 */
2552 yap_flags[HALT_AFTER_CONSULT_FLAG] = yap_init->HaltAfterConsult;
2553 }
2554 /* tell the system who should cope with interruptions */
2555 Yap_ExecutionMode = yap_init->ExecutionMode;
2556 if (do_bootstrap) {
2557 restore_result = YAP_BOOT_FROM_PROLOG;
2558 } else if (BOOT_FROM_SAVED_STATE) {
2559 restore_result = Yap_Restore(yap_init->SavedState, yap_init->YapLibDir);
2560 if (restore_result == FAIL_RESTORE) {
2561 yap_init->ErrorNo = Yap_Error_TYPE;
2562 yap_init->ErrorCause = Yap_ErrorMessage;
2563 /* shouldn't RECOVER_MACHINE_REGS(); be here ??? */
2564 return YAP_BOOT_ERROR;
2565 }
2566 } else {
2567 restore_result = YAP_BOOT_FROM_PROLOG;
2568 }
2569 yap_flags[FAST_BOOT_FLAG] = yap_init->FastBoot;
2570 #if defined(YAPOR) || defined(TABLING)
2571 #ifdef TABLING
2572 /* make sure we initialise this field */
2573 GLOBAL_root_dep_fr = NULL;
2574 #endif
2575 make_root_frames();
2576 #ifdef YAPOR
2577 init_workers();
2578 #endif /* YAPOR */
2579 Yap_init_local();
2580 #ifdef YAPOR
2581 if (worker_id != 0) {
2582 #if SBA||ENV_COPY
2583 /*
2584 In the SBA we cannot just happily inherit registers
2585 from the other workers
2586 */
2587 Yap_InitYaamRegs();
2588 #endif /* SBA */
2589 #ifndef THREADS
2590 Yap_InitPreAllocCodeSpace();
2591 #endif
2592 /* slaves, waiting for work */
2593 CurrentModule = USER_MODULE;
2594 P = GETWORK_FIRST_TIME;
2595 Yap_exec_absmi(FALSE);
2596 Yap_Error(INTERNAL_ERROR, TermNil, "abstract machine unexpected exit (YAP_Init)");
2597 }
2598 #endif /* YAPOR */
2599 #endif /* YAPOR || TABLING */
2600 RECOVER_MACHINE_REGS();
2601 }
2602 /* make sure we do this after restore */
2603 if (yap_init->MaxStackSize) {
2604 Yap_AllowLocalExpansion = FALSE;
2605 } else {
2606 Yap_AllowLocalExpansion = TRUE;
2607 }
2608 if (yap_init->MaxGlobalSize) {
2609 Yap_AllowGlobalExpansion = FALSE;
2610 } else {
2611 Yap_AllowGlobalExpansion = TRUE;
2612 }
2613 if (yap_init->MaxTrailSize) {
2614 Yap_AllowTrailExpansion = FALSE;
2615 } else {
2616 Yap_AllowTrailExpansion = TRUE;
2617 }
2618 if (yap_init->YapPrologRCFile) {
2619 Yap_PutValue(AtomConsultOnBoot, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologRCFile)));
2620 /*
2621 This must be done again after restore, as yap_flags
2622 has been overwritten ....
2623 */
2624 yap_flags[HALT_AFTER_CONSULT_FLAG] = yap_init->HaltAfterConsult;
2625 }
2626 #ifdef MYDDAS_MYSQL
2627 if (yap_init->myddas) {
2628 Yap_PutValue(AtomMyddasGoal,MkIntegerTerm(yap_init->myddas));
2629
2630 /* Mandatory Fields */
2631 Yap_PutValue(AtomMyddasUser,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_user)));
2632 Yap_PutValue(AtomMyddasDB,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_db)));
2633
2634 /* Non-Mandatory Fields */
2635 if (yap_init->myddas_pass != NULL)
2636 Yap_PutValue(AtomMyddasPass,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_pass)));
2637 if (yap_init->myddas_host != NULL)
2638 Yap_PutValue(AtomMyddasHost,MkAtomTerm(Yap_LookupAtom(yap_init->myddas_host)));
2639 }
2640 #endif
2641 if (yap_init->YapPrologTopLevelGoal) {
2642 Yap_PutValue(AtomTopLevelGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal)));
2643 }
2644 if (yap_init->YapPrologGoal) {
2645 Yap_PutValue(AtomInitGoal, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologGoal)));
2646 }
2647 if (yap_init->YapPrologAddPath) {
2648 Yap_PutValue(AtomExtendFileSearchPath, MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologAddPath)));
2649 }
2650 if (yap_init->QuietMode) {
2651 yap_flags[QUIET_MODE_FLAG] = TRUE;
2652 }
2653 if (BOOT_FROM_SAVED_STATE && !do_bootstrap) {
2654 if (restore_result == FAIL_RESTORE) {
2655 yap_init->ErrorNo = Yap_Error_TYPE;
2656 yap_init->ErrorCause = Yap_ErrorMessage;
2657 return YAP_BOOT_ERROR;
2658 }
2659 if (Atts && Atts*1024 > 2048*sizeof(CELL))
2660 Yap_AttsSize = Atts*1024;
2661 else
2662 Yap_AttsSize = 2048*sizeof(CELL);
2663 if (restore_result == DO_ONLY_CODE) {
2664 /* first, initialise the saved state */
2665 Term t_goal = MkAtomTerm(AtomStartupSavedState);
2666 YAP_RunGoalOnce(t_goal);
2667 Yap_InitYaamRegs();
2668 /* reset stacks */
2669 return YAP_BOOT_FROM_SAVED_CODE;
2670 } else {
2671 return YAP_BOOT_FROM_SAVED_STACKS;
2672 }
2673 } else {
2674
2675 /* read the bootfile */
2676 if (!do_bootstrap) {
2677 construct_init_file(boot_file, BootFile);
2678 yap_init->YapPrologBootFile = boot_file;
2679 }
2680 do_bootfile (yap_init->YapPrologBootFile ? yap_init->YapPrologBootFile : BootFile);
2681 /* initialise the top-level */
2682 if (!do_bootstrap) {
2683 char init_file[256];
2684 Atom atfile;
2685 Functor fgoal;
2686 YAP_Term goal, as[2];
2687 construct_init_file(init_file, InitFile);
2688 /* consult init file */
2689 atfile = Yap_LookupAtom(init_file);
2690 as[0] = MkAtomTerm(atfile);
2691 fgoal = Yap_MkFunctor(Yap_FullLookupAtom("$silent_bootstrap"), 1);
2692 goal = Yap_MkApplTerm(fgoal, 1, as);
2693 /* launch consult */
2694 YAP_RunGoalOnce(goal);
2695 /* set default module to user */
2696 as[0] = MkAtomTerm(AtomUser);
2697 fgoal = Yap_MkFunctor(Yap_LookupAtom("module"), 1);
2698 goal = Yap_MkApplTerm(fgoal, 1, as);
2699 YAP_RunGoalOnce(goal);
2700 /* reset stacks */
2701 Yap_InitYaamRegs();
2702 }
2703 Yap_PutValue(Yap_FullLookupAtom("$live"), MkAtomTerm (Yap_FullLookupAtom("$true")));
2704 }
2705 return YAP_BOOT_FROM_PROLOG;
2706 }
2707
2708 X_API Int
YAP_FastInit(char saved_state[])2709 YAP_FastInit(char saved_state[])
2710 {
2711 YAP_init_args init_args;
2712 Int out;
2713
2714 init_args.SavedState = saved_state;
2715 init_args.AttsSize = 0;
2716 init_args.HeapSize = 0;
2717 init_args.StackSize = 0;
2718 init_args.TrailSize = 0;
2719 init_args.MaxAttsSize = 0;
2720 init_args.MaxHeapSize = 0;
2721 init_args.MaxStackSize = 0;
2722 init_args.MaxGlobalSize = 0;
2723 init_args.MaxTrailSize = 0;
2724 init_args.YapLibDir = NULL;
2725 init_args.YapPrologBootFile = NULL;
2726 init_args.YapPrologInitFile = NULL;
2727 init_args.YapPrologRCFile = NULL;
2728 init_args.YapPrologGoal = NULL;
2729 init_args.YapPrologTopLevelGoal = NULL;
2730 init_args.YapPrologAddPath = NULL;
2731 init_args.HaltAfterConsult = FALSE;
2732 init_args.FastBoot = FALSE;
2733 init_args.NumberWorkers = 1;
2734 init_args.SchedulerLoop = 10;
2735 init_args.DelayedReleaseLoad = 3;
2736 init_args.PrologShouldHandleInterrupts = FALSE;
2737 init_args.ExecutionMode = INTERPRETED;
2738 init_args.Argc = 0;
2739 init_args.Argv = NULL;
2740 init_args.ErrorNo = 0;
2741 init_args.ErrorCause = NULL;
2742 init_args.QuietMode = FALSE;
2743 out = YAP_Init(&init_args);
2744 if (out == YAP_BOOT_ERROR) {
2745 Yap_Error(init_args.ErrorNo,TermNil,init_args.ErrorCause);
2746 }
2747 return out;
2748 }
2749
2750 X_API void
YAP_PutValue(Atom at,Term t)2751 YAP_PutValue(Atom at, Term t)
2752 {
2753 Yap_PutValue(at, t);
2754 }
2755
2756 X_API Term
YAP_GetValue(Atom at)2757 YAP_GetValue(Atom at)
2758 {
2759 return(Yap_GetValue(at));
2760 }
2761
2762 X_API int
YAP_CompareTerms(Term t1,Term t2)2763 YAP_CompareTerms(Term t1, Term t2)
2764 {
2765 return Yap_compare_terms(t1, t2);
2766 }
2767
2768 X_API int
YAP_Reset(void)2769 YAP_Reset(void)
2770 {
2771 BACKUP_MACHINE_REGS();
2772
2773 /* first, backtrack to the root */
2774 if (B != NULL) {
2775 while (B->cp_b != NULL)
2776 B = B->cp_b;
2777 P = (yamop *)FAILCODE;
2778 if (Yap_exec_absmi(0) != 0)
2779 return(FALSE);
2780 }
2781 /* reinitialise the engine */
2782 Yap_InitYaamRegs();
2783 Yap_Initialised = TRUE;
2784
2785 RECOVER_MACHINE_REGS();
2786 return(TRUE);
2787 }
2788
2789 X_API void
YAP_Exit(int retval)2790 YAP_Exit(int retval)
2791 {
2792 Yap_exit(retval);
2793 }
2794
2795 X_API void
YAP_InitSocks(char * host,long port)2796 YAP_InitSocks(char *host, long port)
2797 {
2798 #if USE_SOCKET
2799 Yap_init_socks(host, port);
2800 #endif
2801 }
2802
2803 X_API void
YAP_SetOutputMessage(void)2804 YAP_SetOutputMessage(void)
2805 {
2806 #if DEBUG
2807 Yap_output_msg = TRUE;
2808 #endif
2809 }
2810
2811 X_API int
YAP_StreamToFileNo(Term t)2812 YAP_StreamToFileNo(Term t)
2813 {
2814 return(Yap_StreamToFileNo(t));
2815 }
2816
2817 X_API void
YAP_CloseAllOpenStreams(void)2818 YAP_CloseAllOpenStreams(void)
2819 {
2820 BACKUP_H();
2821
2822 Yap_CloseStreams(FALSE);
2823
2824 RECOVER_H();
2825 }
2826
2827 X_API void
YAP_FlushAllStreams(void)2828 YAP_FlushAllStreams(void)
2829 {
2830 BACKUP_H();
2831
2832 Yap_FlushStreams();
2833
2834 RECOVER_H();
2835 }
2836
2837 X_API Term
YAP_OpenStream(void * fh,char * name,Term nm,int flags)2838 YAP_OpenStream(void *fh, char *name, Term nm, int flags)
2839 {
2840 Term retv;
2841
2842 BACKUP_H();
2843
2844 retv = Yap_OpenStream((FILE *)fh, name, nm, flags);
2845
2846 RECOVER_H();
2847 return retv;
2848 }
2849
2850 X_API void
YAP_Throw(Term t)2851 YAP_Throw(Term t)
2852 {
2853 BACKUP_MACHINE_REGS();
2854 Yap_JumpToEnv(t);
2855 RECOVER_MACHINE_REGS();
2856 }
2857
2858 X_API void
YAP_AsyncThrow(Term t)2859 YAP_AsyncThrow(Term t)
2860 {
2861 BACKUP_MACHINE_REGS();
2862 Yap_PrologMode |= AsyncIntMode;
2863 Yap_JumpToEnv(t);
2864 Yap_PrologMode &= ~AsyncIntMode;
2865 RECOVER_MACHINE_REGS();
2866 }
2867
2868 X_API void
YAP_Halt(int i)2869 YAP_Halt(int i)
2870 {
2871 Yap_exit(i);
2872 }
2873
2874 X_API CELL *
YAP_TopOfLocalStack(void)2875 YAP_TopOfLocalStack(void)
2876 {
2877 return(ASP);
2878 }
2879
2880 X_API void *
YAP_Predicate(Atom a,UInt arity,Term m)2881 YAP_Predicate(Atom a, UInt arity, Term m)
2882 {
2883 if (arity == 0) {
2884 return((void *)RepPredProp(PredPropByAtom(a,m)));
2885 } else {
2886 Functor f = Yap_MkFunctor(a, arity);
2887 return((void *)RepPredProp(PredPropByFunc(f,m)));
2888 }
2889 }
2890
2891 X_API void
YAP_PredicateInfo(void * p,Atom * a,UInt * arity,Term * m)2892 YAP_PredicateInfo(void *p, Atom* a, UInt* arity, Term* m)
2893 {
2894 PredEntry *pd = (PredEntry *)p;
2895 if (pd->ArityOfPE) {
2896 *arity = pd->ArityOfPE;
2897 *a = NameOfFunctor(pd->FunctorOfPred);
2898 } else {
2899 *arity = 0;
2900 *a = (Atom)(pd->FunctorOfPred);
2901 }
2902 if (pd->ModuleOfPred)
2903 *m = pd->ModuleOfPred;
2904 else
2905 *m = TermProlog;
2906 }
2907
2908 X_API void
YAP_UserCPredicate(char * name,CPredicate def,UInt arity)2909 YAP_UserCPredicate(char *name, CPredicate def, UInt arity)
2910 {
2911 Yap_InitCPred(name, arity, def, UserCPredFlag);
2912 }
2913
2914 X_API void
YAP_UserBackCPredicate(char * name,CPredicate init,CPredicate cont,UInt arity,unsigned int extra)2915 YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
2916 UInt arity, unsigned int extra)
2917 {
2918 #ifdef CUT_C
2919 Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL ,UserCPredFlag);
2920 #else
2921 Yap_InitCPredBack(name, arity, extra, init, cont, UserCPredFlag);
2922 #endif
2923
2924 }
2925
2926 #ifdef CUT_C
2927 X_API void
YAP_UserBackCutCPredicate(char * name,CPredicate init,CPredicate cont,CPredicate cut,UInt arity,unsigned int extra)2928 YAP_UserBackCutCPredicate(char *name, CPredicate init, CPredicate cont, CPredicate cut,
2929 UInt arity, unsigned int extra)
2930 {
2931 Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag);
2932 }
2933 #endif
2934
2935
2936 X_API void
YAP_UserCPredicateWithArgs(char * a,CPredicate f,UInt arity,Term mod)2937 YAP_UserCPredicateWithArgs(char *a, CPredicate f, UInt arity, Term mod)
2938 {
2939 PredEntry *pe;
2940 Term cm = CurrentModule;
2941 CurrentModule = mod;
2942 YAP_UserCPredicate(a,f,arity);
2943 if (arity == 0) {
2944 pe = RepPredProp(PredPropByAtom(Yap_LookupAtom(a),mod));
2945 } else {
2946 Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity);
2947 pe = RepPredProp(PredPropByFunc(f,mod));
2948 }
2949 pe->PredFlags |= CArgsPredFlag;
2950 CurrentModule = cm;
2951 }
2952
2953 X_API Term
YAP_CurrentModule(void)2954 YAP_CurrentModule(void)
2955 {
2956 return(CurrentModule);
2957 }
2958
2959 X_API Term
YAP_CreateModule(Atom at)2960 YAP_CreateModule(Atom at)
2961 {
2962 Term t;
2963 WRITE_LOCK(RepAtom(at)->ARWLock);
2964 t = Yap_Module(MkAtomTerm(at));
2965 WRITE_UNLOCK(RepAtom(at)->ARWLock);
2966 return t;
2967
2968 }
2969
2970 X_API Term
YAP_StripModule(Term t,Term * modp)2971 YAP_StripModule(Term t, Term *modp)
2972 {
2973 return Yap_StripModule(t, modp);
2974 }
2975
2976
2977 X_API int
YAP_ThreadSelf(void)2978 YAP_ThreadSelf(void)
2979 {
2980 #if THREADS
2981 return Yap_thread_self();
2982 #else
2983 return -2;
2984 #endif
2985 }
2986
2987 X_API int
YAP_ThreadCreateEngine(struct thread_attr_struct * attr)2988 YAP_ThreadCreateEngine(struct thread_attr_struct * attr)
2989 {
2990 #if THREADS
2991 return Yap_thread_create_engine(attr);
2992 #else
2993 return -1;
2994 #endif
2995 }
2996
2997 X_API int
YAP_ThreadAttachEngine(int wid)2998 YAP_ThreadAttachEngine( int wid)
2999 {
3000 #if THREADS
3001 return Yap_thread_attach_engine(wid);
3002 #else
3003 return FALSE;
3004 #endif
3005 }
3006
3007 X_API int
YAP_ThreadDetachEngine(int wid)3008 YAP_ThreadDetachEngine(int wid)
3009 {
3010 #if THREADS
3011 return Yap_thread_detach_engine(wid);
3012 #else
3013 return FALSE;
3014 #endif
3015 }
3016
3017 X_API int
YAP_ThreadDestroyEngine(int wid)3018 YAP_ThreadDestroyEngine(int wid)
3019 {
3020 #if THREADS
3021 return Yap_thread_destroy_engine(wid);
3022 #else
3023 return FALSE;
3024 #endif
3025 }
3026
3027 X_API Term
YAP_TermNil(void)3028 YAP_TermNil(void)
3029 {
3030 return TermNil;
3031 }
3032
3033 X_API int
YAP_AtomGetHold(Atom at)3034 YAP_AtomGetHold(Atom at)
3035 {
3036 return Yap_AtomIncreaseHold(at);
3037 }
3038
3039 X_API int
YAP_AtomReleaseHold(Atom at)3040 YAP_AtomReleaseHold(Atom at)
3041 {
3042 return Yap_AtomDecreaseHold(at);
3043 }
3044
3045 X_API Agc_hook
YAP_AGCRegisterHook(Agc_hook hook)3046 YAP_AGCRegisterHook(Agc_hook hook)
3047 {
3048 Agc_hook old = AGCHook;
3049 AGCHook = hook;
3050 return old;
3051 }
3052
3053 X_API int
YAP_HaltRegisterHook(HaltHookFunc hook,void * closure)3054 YAP_HaltRegisterHook(HaltHookFunc hook, void * closure)
3055 {
3056 return Yap_HaltRegisterHook(hook, closure);
3057 }
3058
3059 X_API char *
YAP_cwd(void)3060 YAP_cwd(void)
3061 {
3062 char *buf;
3063 int len;
3064 if (!Yap_getcwd(Yap_FileNameBuf, YAP_FILENAME_MAX))
3065 return FALSE;
3066 len = strlen(Yap_FileNameBuf);
3067 buf = Yap_AllocCodeSpace(len+1);
3068 if (!buf)
3069 return NULL;
3070 strncpy(buf, Yap_FileNameBuf, len);
3071 return buf;
3072 }
3073
3074 X_API Term
YAP_OpenList(int n)3075 YAP_OpenList(int n)
3076 {
3077 Term t;
3078 BACKUP_H();
3079
3080 if (H+2*n > ASP-1024) {
3081 if (!dogc()) {
3082 RECOVER_H();
3083 return FALSE;
3084 }
3085 }
3086 t = AbsPair(H);
3087 H += 2*n;
3088
3089 RECOVER_H();
3090 return t;
3091 }
3092
3093 X_API Term
YAP_ExtendList(Term t0,Term inp)3094 YAP_ExtendList(Term t0, Term inp)
3095 {
3096 Term t;
3097 CELL *ptr = RepPair(t0);
3098 BACKUP_H();
3099
3100 ptr[0] = inp;
3101 ptr[1] = AbsPair(ptr+2);
3102 t = AbsPair(ptr+2);
3103
3104 RECOVER_H();
3105 return t;
3106 }
3107
3108 X_API int
YAP_CloseList(Term t0,Term tail)3109 YAP_CloseList(Term t0, Term tail)
3110 {
3111 CELL *ptr = RepPair(t0);
3112
3113 RESET_VARIABLE(ptr-1);
3114 if (!Yap_unify((Term)(ptr-1), tail))
3115 return FALSE;
3116 return TRUE;
3117 }
3118
3119 X_API int
YAP_IsAttVar(Term t)3120 YAP_IsAttVar(Term t)
3121 {
3122 t = Deref(t);
3123 if (!IsVarTerm(t))
3124 return FALSE;
3125 return IsAttVar(VarOfTerm(t));
3126 }
3127
3128 X_API Term
YAP_AttsOfVar(Term t)3129 YAP_AttsOfVar(Term t)
3130 {
3131 attvar_record *attv;
3132
3133 t = Deref(t);
3134 if (!IsVarTerm(t))
3135 return TermNil;
3136 if (IsAttVar(VarOfTerm(t)))
3137 return TermNil;
3138 attv = (attvar_record *)VarOfTerm(t);
3139 return attv->Atts;
3140 }
3141
3142 X_API int
YAP_FileNoFromStream(Term t)3143 YAP_FileNoFromStream(Term t)
3144 {
3145
3146 t = Deref(t);
3147 if (IsVarTerm(t))
3148 return -1;
3149 return Yap_StreamToFileNo(t);
3150 }
3151
3152 X_API void *
YAP_FileDescriptorFromStream(Term t)3153 YAP_FileDescriptorFromStream(Term t)
3154 {
3155
3156 t = Deref(t);
3157 if (IsVarTerm(t))
3158 return NULL;
3159 return Yap_FileDescriptorFromStream(t);
3160 }
3161
3162 X_API void *
YAP_Record(Term t)3163 YAP_Record(Term t)
3164 {
3165 DBTerm *dbterm;
3166 DBRecordList *dbt;
3167
3168 dbterm = Yap_StoreTermInDB(Deref(t), 0);
3169 if (dbterm == NULL)
3170 return NULL;
3171 dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list));
3172 while (dbt == NULL) {
3173 if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) {
3174 /* be a good neighbor */
3175 Yap_FreeCodeSpace((void *)dbterm);
3176 Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "using YAP_Record");
3177 return NULL;
3178 }
3179 }
3180 if (Yap_Records) {
3181 Yap_Records->prev_rec = dbt;
3182 }
3183 dbt->next_rec = Yap_Records;
3184 dbt->prev_rec = NULL;
3185 dbt->dbrecord = dbterm;
3186 Yap_Records = dbt;
3187 return dbt;
3188 }
3189
3190 X_API Term
YAP_Recorded(void * handle)3191 YAP_Recorded(void *handle)
3192 {
3193 Term t;
3194 DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord;
3195
3196 BACKUP_MACHINE_REGS();
3197 do {
3198 Yap_Error_TYPE = YAP_NO_ERROR;
3199 t = Yap_FetchTermFromDB(dbterm);
3200 if (Yap_Error_TYPE == YAP_NO_ERROR) {
3201 RECOVER_MACHINE_REGS();
3202 return t;
3203 } else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
3204 Yap_Error_TYPE = YAP_NO_ERROR;
3205 if (!Yap_growglobal(NULL)) {
3206 Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
3207 RECOVER_MACHINE_REGS();
3208 return FALSE;
3209 }
3210 } else {
3211 Yap_Error_TYPE = YAP_NO_ERROR;
3212 if (!Yap_growstack(dbterm->NOfCells*CellSize)) {
3213 Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
3214 RECOVER_MACHINE_REGS();
3215 return FALSE;
3216 }
3217 }
3218 } while (t == (CELL)0);
3219 RECOVER_MACHINE_REGS();
3220 return t;
3221 }
3222
3223 X_API int
YAP_Erase(void * handle)3224 YAP_Erase(void *handle)
3225 {
3226 DBRecordList *dbr = (DBRecordList *)handle;
3227 Yap_ReleaseTermFromDB(dbr->dbrecord);
3228 if (dbr->next_rec)
3229 dbr->next_rec->prev_rec = dbr->prev_rec;
3230 if (dbr->prev_rec)
3231 dbr->next_rec->prev_rec = dbr->next_rec;
3232 else if (Yap_Records == dbr) {
3233 Yap_Records = dbr->next_rec;
3234 }
3235 Yap_FreeCodeSpace(handle);
3236 return 1;
3237 }
3238
3239 X_API Int
YAP_ArgsToSlots(int n)3240 YAP_ArgsToSlots(int n)
3241 {
3242 Int slot = Yap_NewSlots(n);
3243 CELL *ptr0 = LCL0+slot, *ptr1=&ARG1;
3244 while (n--) {
3245 *ptr0++ = *ptr1++;
3246 }
3247 return slot;
3248 }
3249
3250 X_API void
YAP_SlotsToArgs(int n,Int slot)3251 YAP_SlotsToArgs(int n, Int slot)
3252 {
3253 CELL *ptr0 = LCL0+slot, *ptr1=&ARG1;
3254 while (n--) {
3255 *ptr1++ = *ptr0++;
3256 }
3257 }
3258
3259
3260 X_API int
YAP_SetYAPFlag(yap_flag_t flag,int val)3261 YAP_SetYAPFlag(yap_flag_t flag, int val)
3262 {
3263 switch (flag) {
3264 case YAPC_ENABLE_GC:
3265 if (val) {
3266 Yap_PutValue(AtomGc, MkAtomTerm(AtomTrue));
3267 } else {
3268 Yap_PutValue(AtomGc, TermNil);
3269 }
3270 return TRUE;
3271 case YAPC_ENABLE_AGC:
3272 if (val) {
3273 AGcThreshold = 10000;
3274 } else {
3275 AGcThreshold = 0;
3276 }
3277 return TRUE;
3278 default:
3279 return FALSE;
3280 }
3281 }
3282
3283
3284
3285