YAP 7.1.0
c_interface.c
Go to the documentation of this file.
1/************************************************************************* *
2 * YAP Prolog *
3 * Yap Prolog was developed at NCCUP - Universidade do Porto *
4 * *
5 * Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- *
6 * *
7 **************************************************************************
8 * *
9 * File: c_interface.c *
10 * comments: c_interface primitives definition *
11 * *
12 * Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
13 **
14 * $Log: not supported by cvs2svn $
15 * *
16 * *
17 *************************************************************************/
18
25#ifndef C_INTERFACE_C
26
27#define C_INTERFACE_C 1
28#define _EXPORT_KERNEL 1
29
30#include <stdlib.h>
31
32#if HAVE_UNISTD_H
33#include <unistd.h>
34#endif
35
36#include <string.h>
37
38#if HAVE_STDARG_H
39#include <stdarg.h>
40#endif
41#if _MSC_VER || defined(__MINGW32__)
42#include <windows.h>
43#endif
44// we cannot consult YapInterface.h, that conflicts with what we declare, though
45// it shouldn't
46
47#include "Yap.h"
48#include "YapHeap.h"
49#include "YapSignals.h"
50#include "YapInterface.h"
51#include "YapText.h"
52#include "attvar.h"
53#include "clause.h"
54#include "yapio.h"
55
56#ifdef TABLING
57
58#include "tab.macros.h"
59
60#endif /* TABLING */
61#ifdef YAPOR
62#include "or.macros.h"
63#endif /* YAPOR */
64
65#include "cut_c.h"
66
67#if HAVE_MALLOC_H
68
69#include <malloc.h>
70
71#endif
72
73#include "iopreds.h"
74#include <libgen.h>
75#include <Yatom.h>
76#include <heapgc.h>
77
78typedef void *atom_t;
79typedef void *functor_t;
80
81typedef enum {
82 FRG_FIRST_CALL = 0, /* Initial call */
83 FRG_CUTTED = 1, /* Context was cutted */
84 FRG_REDO = 2 /* Normal redo */
85} frg_code;
86
88 uintptr_t context; /* context value */
89 frg_code control; /* FRG_* action */
90 struct PL_local_data *engine; /* invoking engine */
91};
92
93X_API bool python_in_python;
94
95X_API int YAP_Reset(yap_reset_t mode, bool reset_global);
96
97#if !HAVE_STRNCPY
98#define strncpy(X, Y, Z) strcpy(X, Y)
99#endif
100#if !HAVE_STRNCAT
101#define strncat(X, Y, Z) strcat(X, Y)
102#endif
103
104#if defined(_WIN32) && !defined(X_API)
105#define X_API __declspec(dllexport)
106#endif
107
108#define SOURCEBOOTPath NULL
109#if __ANDROID__
110#define BOOT_FROM_SAVED_STATE true
111#endif
112
144X_API void YAP_StartSlots(void)
145{
146 Yap_RebootHandles(worker_id);
147}
148
151X_API void YAP_EndSlots(void)
152{
153 Yap_RebootHandles(worker_id);
154}
155
160X_API yhandle_t YAP_CurrentSlot(void);
161
166
171X_API yhandle_t YAP_InitSlot(YAP_Term t);
172
176X_API YAP_Term YAP_GetFromSlot(YAP_handle_t slot);
177
181X_API YAP_Term *YAP_AddressFromSlot(YAP_handle_t);
182
186X_API YAP_Term *YAP_AddressOfTermInSlot(YAP_handle_t);
187
191X_API void YAP_PutInSlot(YAP_handle_t slot, YAP_Term t);
192
197X_API int YAP_RecoverSlots(int, YAP_handle_t topSlot);
198
202X_API YAP_handle_t YAP_ArgsToSlots(int HowMany);
203
208// starting at _slot_.
209X_API void YAP_SlotsToArgs(int HowMany, YAP_handle_t slot);
210
211static arity_t current_arity(void) {
212 CACHE_REGS
213 if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
214 return PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
215 } else {
216 return 0;
217 }
218}
219
220static int doexpand(UInt sz) {
221 CACHE_REGS
222
223 gc_entry_info_t info;
224 Yap_track_cpred( 0, P, 0, &info);
225 if (!Yap_gc(&info)) {
226 return FALSE;
227 }
228 return TRUE;
229}
230
231X_API YAP_Term YAP_A(int i) {
232 CACHE_REGS
233 return (Deref(XREGS[i]));
234}
235
236X_API YAP_Term YAP_SetA(int i, YAP_Term t) {
237 CACHE_REGS
238 return (Deref(XREGS[i]));
239}
240
241X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); }
242
243X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) {
244 return IsIntegerTerm(t) || IsIntTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t);
245}
246
247X_API YAP_Bool YAP_IsLongIntTerm(YAP_Term t) { return IsLongIntTerm(t); }
248
249X_API YAP_Bool YAP_IsBigNumTerm(YAP_Term t) {
250 CELL *pt;
251 if (IsVarTerm(t))
252 return FALSE;
253 if (!IsBigIntTerm(t))
254 return FALSE;
255 pt = RepAppl(t);
256 return pt[1] == BIG_INT;
257
258}
259
260X_API YAP_Bool YAP_IsRationalTerm(YAP_Term t) {
261 CELL *pt;
262 if (IsVarTerm(t))
263 return FALSE;
264 if (!IsBigIntTerm(t))
265 return FALSE;
266 pt = RepAppl(t);
267 return pt[1] == BIG_RATIONAL;
268}
269
270X_API YAP_Bool YAP_IsStringTerm(YAP_Term t) { return (IsStringTerm(t)); }
271
272X_API YAP_Bool YAP_IsVarTerm(YAP_Term t) { return (IsVarTerm(t)); }
273
274X_API YAP_Bool YAP_IsNonVarTerm(YAP_Term t) { return (IsNonVarTerm(t)); }
275
276X_API YAP_Bool YAP_IsFloatTerm(Term t) { return (IsFloatTerm(t)); }
277
278X_API YAP_Bool YAP_IsDbRefTerm(Term t) { return (IsDBRefTerm(t)); }
279
280X_API YAP_Bool YAP_IsAtomTerm(Term t) { return (IsAtomTerm(t)); }
281
282X_API YAP_Bool YAP_IsPairTerm(Term t) { return (IsPairTerm(t)); }
283
284X_API YAP_Bool YAP_IsApplTerm(Term t) {
285 return IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t));
286}
287
288X_API YAP_Bool YAP_IsCompoundTerm(Term t) {
289 return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) ||
290 IsPairTerm(t);
291}
292
293X_API Term YAP_MkIntTerm(Int n) {
294 CACHE_REGS
295 Term I;
296 BACKUP_H();
297
298 I = MkIntegerTerm(n);
299 RECOVER_H();
300 return I;
301}
302
303X_API Term YAP_MkStringTerm(const char *n) {
304 CACHE_REGS
305 Term I;
306 BACKUP_H();
307
308 I = MkStringTerm(n);
309 RECOVER_H();
310 return I;
311}
312
313X_API Term YAP_MkCharPTerm(char *n) {
314 CACHE_REGS
315 Term I;
316 BACKUP_H();
317
318 I = MkStringTerm(n);
319 RECOVER_H();
320 return I;
321}
322
323X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) {
324 CACHE_REGS
325 Term I;
326 BACKUP_H();
327
328 I = MkUStringTerm(n);
329 RECOVER_H();
330 return I;
331}
332
333X_API const char *YAP_StringOfTerm(Term t) { return StringOfTerm(t); }
334
335X_API const unsigned char *YAP_UnsignedStringOfTerm(Term t) {
336 return UStringOfTerm(t);
337}
338
339X_API Int YAP_IntOfTerm(Term t) {
340 if (!IsApplTerm(t))
341 return IntOfTerm(t);
342 else {
343 return LongIntOfTerm(t);
344 }
345}
346
347X_API Term YAP_MkBigNumTerm(void *big) {
348 Term I;
349 BACKUP_H();
350 I = Yap_MkBigIntTerm(big);
351 RECOVER_H();
352 return I;
353}
354
355X_API YAP_Bool YAP_BigNumOfTerm(Term t, void *b) {
356 MP_INT *bz = (MP_INT *)b;
357 if (IsVarTerm(t))
358 return FALSE;
359 if (!IsBigIntTerm(t))
360 return FALSE;
361 mpz_set(bz, Yap_BigIntOfTerm(t));
362 return TRUE;
363
364}
365
366X_API Term YAP_MkRationalTerm(void *big) {
367 Term I;
368 BACKUP_H();
369 I = Yap_MkBigRatTerm((MP_RAT *)big);
370 RECOVER_H();
371 return I;
372
373}
374
375X_API YAP_Bool YAP_RationalOfTerm(Term t, void *b) {
376 MP_RAT *br = (MP_RAT *)b;
377 if (IsVarTerm(t))
378 return FALSE;
379 if (!IsBigIntTerm(t))
380 return FALSE;
381 mpq_set(br, Yap_BigRatOfTerm(t));
382 return TRUE;
383
384}
385
386X_API Term YAP_MkBlobTerm(unsigned int sz) {
387 CACHE_REGS
388 BACKUP_H();
389
390 while (HR + (sz + 4) > ASP - 1024) {
391 if (!doexpand((sz + 4) * sizeof(CELL))) {
392 Yap_Error(RESOURCE_ERROR_STACK, TermNil,
393 "YAP failed to grow the stack while constructing a blob: %s",
394 LOCAL_ErrorMessage);
395 return TermNil;
396 }
397 }
398 CELL *I = (HR);
399 HR[0] = (CELL)FunctorBlob;
400 HR[1] = ARRAY_INT;
401 HR[2] = sz;
402 HR += (sz+ 4);
403 HR[-1] = CloseExtension((I));
404 RECOVER_H();
405
406 return AbsAppl(I);
407}
408
409X_API void *YAP_BlobOfTerm(Term t) {
410
411
412 if (IsVarTerm(t))
413 return NULL;
414 if (!IsBlobTerm(t))
415 return NULL;
416 return (RepAppl(t) + 3);
417}
418
419X_API Term YAP_MkFloatTerm(double n) {
420 CACHE_REGS
421 Term t;
422 BACKUP_H();
423
424 t = MkFloatTerm(n);
425
426 RECOVER_H();
427 return t;
428}
429
430X_API YAP_Float YAP_FloatOfTerm(YAP_Term t) { return (FloatOfTerm(t)); }
431
432X_API Term YAP_MkAtomTerm(YAP_Atom n) {
433 Term t;
434
435 t = MkAtomTerm(n);
436 return t;
437}
438
439X_API YAP_Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); }
440
441X_API bool YAP_IsWideAtom(YAP_Atom a) {
442 const unsigned char *s = RepAtom(a)->UStrOfAE;
443 int32_t v;
444 while (*s) {
445 size_t n = get_utf8(s, 1, &v);
446 if (n > 1)
447 return true;
448 }
449 return false;
450}
451
452X_API const char *YAP_AtomName(YAP_Atom a) {
453 const char *o;
454
455 o = AtomName(a);
456 return (o);
457}
458
459X_API const wchar_t *YAP_WideAtomName(YAP_Atom a) {
460 int32_t v;
461 const unsigned char *s = RepAtom(a)->UStrOfAE;
462 size_t n = strlen_utf8(s);
463 wchar_t *dest = Malloc((n + 1) * sizeof(wchar_t)), *o = dest;
464 while (*s) {
465 size_t n = get_utf8(s, 1, &v);
466 if (n == 0)
467 return NULL;
468 *o++ = v;
469 }
470 o[0] = '\0';
471 return dest;
472}
473
474X_API YAP_Atom YAP_LookupAtom(const char *c) {
475 CACHE_REGS
476 Atom a;
477
478 while (TRUE) {
479 a = Yap_LookupAtom(c);
480 if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
481 if (!Yap_locked_growheap(FALSE, 0, NULL)) {
482 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
483 LOCAL_ErrorMessage);
484 }
485 } else {
486 return a;
487 }
488 }
489 return NULL;
490}
491
492X_API YAP_Atom YAP_LookupWideAtom(const wchar_t *c) {
493 CACHE_REGS
494 Atom a;
495
496 while (TRUE) {
497 a = Yap_NWCharsToAtom(c, -1 USES_REGS);
498 if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
499 if (!Yap_locked_growheap(FALSE, 0, NULL)) {
500 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
501 LOCAL_ErrorMessage);
502 }
503 } else {
504 return a;
505 }
506 }
507 return NULL;
508}
509
510X_API YAP_Atom YAP_FullLookupAtom(const char *c) {
511 CACHE_REGS
512 Atom at;
513
514 while (TRUE) {
515 at = Yap_FullLookupAtom(c);
516 if (at == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
517 if (!Yap_locked_growheap(FALSE, 0, NULL)) {
518 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
519 LOCAL_ErrorMessage);
520 }
521 } else {
522 return at;
523 }
524 }
525 return NULL;
526}
527
528X_API size_t YAP_AtomNameLength(YAP_Atom at) {
529 if (IsBlob(at)) {
530 return RepAtom(at)->rep.blob->length;
531 }
532 unsigned char *c = RepAtom(at)->UStrOfAE;
533
534 return strlen_utf8(c);
535}
536
537X_API Term YAP_MkVarTerm(void) {
538 CACHE_REGS
539 CELL t;
540 BACKUP_H();
541
542 t = MkVarTerm();
543
544 RECOVER_H();
545 return t;
546}
547
548X_API Term YAP_MkPairTerm(Term t1, Term t2) {
549 CACHE_REGS
550 Term t;
551 BACKUP_H();
552
553 while (HR > ASP - 1024) {
554 Int sl1 = Yap_InitSlot(t1);
555 Int sl2 = Yap_InitSlot(t2);
556 RECOVER_H();
557 return TermNil;
558 gc_entry_info_t info;
559 Yap_track_cpred( 0, P, 0, &info);
560 if (!Yap_gc(&info)) {
561 }
562 BACKUP_H();
563 t1 = Yap_GetFromSlot(sl1);
564 t2 = Yap_GetFromSlot(sl2);
565 Yap_RecoverSlots(2, sl2);
566 }
567 t = MkPairTerm(t1, t2);
568 RECOVER_H();
569 return t;
570}
571
572X_API Term YAP_MkListFromTerms(Term *ta, Int sz) {
573 CACHE_REGS
574 Term t;
575 CELL *h;
576 if (sz == 0)
577 return TermNil;
578 BACKUP_H();
579 while (HR + sz * 2 > ASP - 1024) {
580 Int sl1 = Yap_InitSlot((CELL)ta);
581 RECOVER_H();
582 if (!Yap_dogc()) {
583 return TermNil;
584 }
585 BACKUP_H();
586 ta = (CELL *)Yap_GetFromSlot(sl1);
587 Yap_RecoverSlots(1, sl1);
588 }
589 h = HR;
590 t = AbsPair(h);
591 while (sz--) {
592 Term ti = *ta++;
593 if (IsVarTerm(ti)) {
594 RESET_VARIABLE(h);
595 Yap_unify(ti, h[0]);
596 } else {
597 h[0] = ti;
598 }
599 h[1] = AbsPair(h + 2);
600 h += 2;
601 }
602 h[-1] = TermNil;
603 HR = h;
604 RECOVER_H();
605 return t;
606}
607
608X_API Term YAP_MkNewPairTerm() {
609 CACHE_REGS
610 Term t;
611 BACKUP_H();
612
613 if (HR > ASP - 1024)
614 t = TermNil;
615 else
616 t = Yap_MkNewPairTerm();
617
618 RECOVER_H();
619 return t;
620}
621
622X_API Term YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); }
623
624X_API Term YAP_TailOfTerm(Term t) { return (TailOfTerm(t)); }
625
626X_API Int YAP_SkipList(Term *l, Term **tailp) {
627 return Yap_SkipList(l, tailp);
628 Int length = 0;
629 Term *s; /* slow */
630 Term v; /* temporary */
631
632 do_derefa(v, l, derefa_unk, derefa_nonvar);
633 s = l;
634
635 if (IsPairTerm(*l)) {
636 intptr_t power = 1, lam = 0;
637 do {
638 if (power == lam) {
639 s = l;
640 power *= 2;
641 lam = 0;
642 }
643 lam++;
644 length++;
645 l = RepPair(*l) + 1;
646 do_derefa(v, l, derefa2_unk, derefa2_nonvar);
647 } while (*l != *s && IsPairTerm(*l));
648 }
649 *tailp = l;
650
651 return length;
652}
653
654X_API Term YAP_MkApplTerm(YAP_Functor f, UInt arity, Term args[]) {
655 CACHE_REGS
656 Term t;
657 BACKUP_H();
658
659 if (HR + arity > ASP - 1024)
660 t = TermNil;
661 else
662 t = Yap_MkApplTerm(f, arity, args);
663
664 RECOVER_H();
665 return t;
666}
667X_API Term YAP_MkNewApplTerm(YAP_Functor f, UInt arity) {
668 CACHE_REGS
669 Term t;
670 BACKUP_H();
671
672 if (HR + arity > ASP - 1024)
673 t = TermNil;
674 else
675 t = Yap_MkNewApplTerm(f, arity);
676
677 RECOVER_H();
678 return t;
679}
680
681X_API YAP_Functor YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); }
682
683X_API Term YAP_ArgOfTerm(UInt n, Term t) { return (ArgOfTerm(n, t)); }
684
685X_API Term *YAP_ArgsOfTerm(Term t) {
686 if (IsApplTerm(t))
687 return RepAppl(t) + 1;
688 else if (IsPairTerm(t))
689 return RepPair(t);
690 return NULL;
691}
692
693X_API YAP_Functor YAP_MkFunctor(YAP_Atom a, UInt n) {
694 return (Yap_MkFunctor(a, n));
695}
696
697X_API YAP_Atom YAP_NameOfFunctor(YAP_Functor f) { return (NameOfFunctor(f)); }
698
699X_API UInt YAP_ArityOfFunctor(YAP_Functor f) { return (ArityOfFunctor(f)); }
700
701
702
703X_API void *YAP_ExtraSpaceCut(void) {
704#if 0
705CACHE_REGS
706 void *ptr;
707 BACKUP_B();
708
709 ptr = (void *)(((CELL *)(Yap_REGS.CUT_C_TOP)) -
710 (((yamop *)Yap_REGS.CUT_C_TOP->try_userc_cut_yamop)
711 ->y_u.OtapFs.extra));
712
713 RECOVER_B();
714#endif
715 return NULL;
716}
717
718X_API void *YAP_ExtraSpace(void) {
719 CACHE_REGS
720 void *ptr;
721 BACKUP_B();
722 BACKUP_H();
723
724 /* find a pointer to extra space allocable */
725 ptr = (void *)((CELL *)(B + 1) + P->y_u.OtapFs.s);
726 B->cp_h = HR;
727
728 RECOVER_H();
729 RECOVER_B();
730 return (ptr);
731}
732
733X_API void YAP_cut_up(void) {
734 CACHE_REGS
735 BACKUP_B();
736 {
737 while (POP_CHOICE_POINT(B->cp_b)) {
738 POP_EXECUTE();
739 }
740 }
741 /* This is complicated: make sure we can restore the ASP
742 pointer back to where cut_up called it. Slots depend on it. */
743 if (ENV > B->cp_env) {
744 ASP = B->cp_env;
745 }
746#ifdef YAPOR
747 {
748 choiceptr cut_pt;
749
750 cut_pt = B->cp_b;
751 /* make sure we prune C-choicepoints */
752 if (POP_CHOICE_POINT(B->cp_b)) {
753 POP_EXECUTE();
754 }
755 CUT_prune_to(cut_pt);
756 Yap_TrimTrail();
757 B = cut_pt;
758 }
759#else
760 /* make sure we prune C-choicepoints */
761 if (POP_CHOICE_POINT(B->cp_b)) {
762 POP_EXECUTE();
763 }
764 Yap_TrimTrail();
765 B = B->cp_b; /* cut_fail */
766#endif
767 HB = B->cp_h; /* cut_fail */
768 RECOVER_B();
769}
770
771X_API bool YAP_Unify(Term t1, Term t2) {
772 Int out;
773 BACKUP_MACHINE_REGS();
774
775 out = Yap_unify(t1, t2);
776
777 RECOVER_MACHINE_REGS();
778 return out;
779}
780
781X_API int YAP_Unifiable(Term t1, Term t2) {
782 int out;
783 BACKUP_MACHINE_REGS();
784
785 out = Yap_Unifiable(t1, t2);
786
787 RECOVER_MACHINE_REGS();
788 return out;
789}
790
791/* == */
792X_API int YAP_ExactlyEqual(Term t1, Term t2) {
793 int out;
794 BACKUP_MACHINE_REGS();
795
796 out = Yap_eq(t1, t2);
797
798 RECOVER_MACHINE_REGS();
799 return out;
800}
801
802/* =@= */
803X_API int YAP_Variant(Term t1, Term t2) {
804 int out;
805 BACKUP_MACHINE_REGS();
806
807 out = Yap_Variant(Deref(t1), Deref(t2));
808
809 RECOVER_MACHINE_REGS();
810 return out;
811}
812
813/* =@= */
814X_API Int YAP_TermHash(Term t, Int sz, Int depth, int variant) {
815 Int out;
816
817 BACKUP_MACHINE_REGS();
818
819 out = Yap_TermHash(t, sz, depth, variant);
820
821 RECOVER_MACHINE_REGS();
822 return out;
823}
824
825X_API Int YAP_CurrentSlot(void) {
826 CACHE_REGS
827 return Yap_CurrentSlot();
828}
829
830X_API Int YAP_NewSlots(int n) {
831 CACHE_REGS
832 return Yap_NewSlots(n);
833}
834
835X_API Int YAP_InitSlot(Term t) {
836 CACHE_REGS
837 return Yap_InitSlot(t);
838}
839
840X_API int YAP_RecoverSlots(int n, Int top_slot) {
841 CACHE_REGS
842 return Yap_RecoverSlots(n, top_slot);
843}
844
845X_API Term YAP_GetFromSlot(Int slot) {
846 CACHE_REGS
847 return Yap_GetFromSlot(slot);
848}
849
850X_API Term *YAP_AddressFromSlot(Int slot) {
851 CACHE_REGS
852 return Yap_AddressFromSlot(slot);
853}
854
855X_API Term *YAP_AddressOfTermInSlot(Int slot) {
856 CACHE_REGS
857 Term *b = Yap_AddressFromSlot(slot);
858 Term a = *b;
859restart:
860 if (!IsVarTerm(a)) {
861 return (b);
862 } else if (a == (CELL)b) {
863 return (b);
864 } else {
865 b = (CELL *)a;
866 a = *b;
867 goto restart;
868 }
869}
870
871X_API void YAP_PutInSlot(Int slot, Term t) {
872 CACHE_REGS
873 Yap_PutInSlot(slot, t);
874}
875
876typedef Int (*CPredicate0)(void);
877
878typedef Int (*CPredicate1)(yhandle_t);
879
880typedef Int (*CPredicate2)(yhandle_t, yhandle_t);
881
882typedef Int (*CPredicate3)(yhandle_t, yhandle_t, yhandle_t);
883
884typedef Int (*CPredicate4)(yhandle_t, yhandle_t, yhandle_t, yhandle_t);
885
886typedef Int (*CPredicate5)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
887 yhandle_t);
888
889typedef Int (*CPredicate6)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
890 yhandle_t, yhandle_t);
891
892typedef Int (*CPredicate7)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
893 yhandle_t, yhandle_t, yhandle_t);
894
895typedef Int (*CPredicate8)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
896 yhandle_t, yhandle_t, yhandle_t, yhandle_t);
897
898typedef Int (*CPredicate9)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
899 yhandle_t, yhandle_t, yhandle_t, yhandle_t,
900 yhandle_t);
901
902typedef Int (*CPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
903 yhandle_t, yhandle_t, yhandle_t, yhandle_t,
904 yhandle_t, yhandle_t);
905
906typedef Int (*CPredicateV)(yhandle_t, yhandle_t, struct foreign_context *);
907
908static Int execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS) {
909 Int rc;
910 yhandle_t a1;
911 switch (pe->ArityOfPE) {
912 case 0: {
913 CPredicate0 code0 = (CPredicate0)exec_code;
914 return code0();
915 }
916 case 1: {
917 CPredicate1 code1 = (CPredicate1)exec_code;
918 a1 = Yap_InitSlots(1, &ARG1);
919 rc = code1(a1);
920 } break;
921 case 2: {
922 CPredicate2 code2 = (CPredicate2)exec_code;
923 a1 = Yap_InitSlots(2, &ARG1);
924 rc = code2(a1, a1 + 1);
925 } break;
926 case 3: {
927 CPredicate3 code3 = (CPredicate3)exec_code;
928 a1 = Yap_InitSlots(3, &ARG1);
929 rc = code3(a1, a1 + 1, a1 + 2);
930 } break;
931 case 4: {
932 CPredicate4 code4 = (CPredicate4)exec_code;
933 a1 = Yap_InitSlots(4, &ARG1);
934 rc = code4(a1, a1 + 1, a1 + 2, a1 + 3);
935 } break;
936 case 5: {
937 CPredicate5 code5 = (CPredicate5)exec_code;
938 a1 = Yap_InitSlots(5, &ARG1);
939 rc = code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4);
940 } break;
941
942 case 6: {
943 CPredicate6 code6 = (CPredicate6)exec_code;
944 a1 = Yap_InitSlots(6, &ARG1);
945 rc = code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5);
946 } break;
947 case 7: {
948 CPredicate7 code7 = (CPredicate7)exec_code;
949 a1 = Yap_InitSlots(7, &ARG1);
950 rc = code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6);
951 } break;
952 case 8: {
953 CPredicate8 code8 = (CPredicate8)exec_code;
954 a1 = Yap_InitSlots(8, &ARG1);
955 rc = code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7);
956 } break;
957 case 9: {
958 CPredicate9 code9 = (CPredicate9)exec_code;
959 a1 = Yap_InitSlots(9, &ARG1);
960 rc = code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
961 a1 + 8);
962 } break;
963 case 10: {
964 CPredicate10 code10 = (CPredicate10)exec_code;
965 a1 = Yap_InitSlots(10, &ARG1);
966 rc = code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
967 a1 + 8, a1 + 9);
968 } break;
969 default:
970 YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil,
971 "YAP only supports SWI C-call with arity =< 10");
972 return false;
973 }
974 Yap_RecoverSlots(pe->ArityOfPE, a1);
975 return rc;
976}
977
978typedef uintptr_t (*CBPredicate0)(struct foreign_context *);
979
980typedef uintptr_t (*CBPredicate1)(yhandle_t, struct foreign_context *);
981
982typedef uintptr_t (*CBPredicate2)(yhandle_t, yhandle_t,
983 struct foreign_context *);
984
985typedef uintptr_t (*CBPredicate3)(yhandle_t, yhandle_t, yhandle_t,
986 struct foreign_context *);
987
988typedef uintptr_t (*CBPredicate4)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
989 struct foreign_context *);
990
991typedef uintptr_t (*CBPredicate5)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
992 yhandle_t, struct foreign_context *);
993
994typedef uintptr_t (*CBPredicate6)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
995 yhandle_t, yhandle_t,
996 struct foreign_context *);
997
998typedef uintptr_t (*CBPredicate7)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
999 yhandle_t, yhandle_t, yhandle_t,
1000 struct foreign_context *);
1001
1002typedef uintptr_t (*CBPredicate8)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
1003 yhandle_t, yhandle_t, yhandle_t, yhandle_t,
1004 struct foreign_context *);
1005
1006typedef uintptr_t (*CBPredicate9)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
1007 yhandle_t, yhandle_t, yhandle_t, yhandle_t,
1008 yhandle_t, struct foreign_context *);
1009
1010typedef uintptr_t (*CBPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
1011 yhandle_t, yhandle_t, yhandle_t, yhandle_t,
1012 yhandle_t, yhandle_t,
1013 struct foreign_context *);
1014
1015static uintptr_t execute_cargs_back(PredEntry *pe, CPredicate exec_code,
1016 struct foreign_context *ctx USES_REGS) {
1017 switch (pe->ArityOfPE) {
1018 case 0: {
1019 CBPredicate0 code0 = (CBPredicate0)exec_code;
1020 return code0(ctx);
1021 }
1022 case 1: {
1023 CBPredicate1 code1 = (CBPredicate1)exec_code;
1024 yhandle_t a1 = Yap_InitSlots(1, &B->cp_a1);
1025 return code1(a1, ctx);
1026 }
1027 case 2: {
1028 CBPredicate2 code2 = (CBPredicate2)exec_code;
1029 yhandle_t a1 = Yap_InitSlots(2, &B->cp_a1);
1030 return code2(a1, a1 + 1, ctx);
1031 }
1032 case 3: {
1033 CBPredicate3 code3 = (CBPredicate3)exec_code;
1034 yhandle_t a1 = Yap_InitSlots(3, &B->cp_a1);
1035 return code3(a1, a1 + 1, a1 + 2, ctx);
1036 }
1037 case 4: {
1038 CBPredicate4 code4 = (CBPredicate4)exec_code;
1039 yhandle_t a1 = Yap_InitSlots(4, &B->cp_a1);
1040 return code4(a1, a1 + 1, a1 + 2, a1 + 3, ctx);
1041 }
1042 case 5: {
1043 CBPredicate5 code5 = (CBPredicate5)exec_code;
1044 yhandle_t a1 = Yap_InitSlots(5, &B->cp_a1);
1045 return code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, ctx);
1046 }
1047 case 6: {
1048 CBPredicate6 code6 = (CBPredicate6)exec_code;
1049 yhandle_t a1 = Yap_InitSlots(6, &B->cp_a1);
1050 return code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, ctx);
1051 }
1052 case 7: {
1053 CBPredicate7 code7 = (CBPredicate7)exec_code;
1054 yhandle_t a1 = Yap_InitSlots(7, &B->cp_a1);
1055 return code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, ctx);
1056 }
1057 case 8: {
1058 CBPredicate8 code8 = (CBPredicate8)exec_code;
1059 yhandle_t a1 = Yap_InitSlots(8, &B->cp_a1);
1060 return code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
1061 ctx);
1062 }
1063 case 9: {
1064 CBPredicate9 code9 = (CBPredicate9)exec_code;
1065 yhandle_t a1 = Yap_InitSlots(9, &B->cp_a1);
1066 return code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
1067 a1 + 8, ctx);
1068 }
1069 case 10: {
1070 CBPredicate10 code10 = (CBPredicate10)exec_code;
1071 yhandle_t a1 = Yap_InitSlots(10, &B->cp_a1);
1072 return code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
1073 a1 + 8, a1 + 9, ctx);
1074 }
1075 default:
1076 YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1077 "YAP only supports SWI C-call with arity =< 10");
1078 return (FALSE);
1079 }
1080}
1081
1082static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) {
1083 // this case is easy, jut be sure to throw everything
1084 // after the old B;
1085 while (B && B->cp_b && B->cp_b <= ptr) {
1086 B = B->cp_b;
1087 }
1088 if (has_cp)
1089 return do_cut(FALSE);
1090 return FALSE;
1091}
1092
1093static uintptr_t complete_exit(choiceptr ptr, int has_cp,
1094 int cut_all USES_REGS) {
1095 // the user often leaves open frames, especially in forward execution
1096 while (B && (!ptr || B < ptr)) {
1097 if (cut_all || B->cp_ap == EXITCODE) { /* separator */
1098 do_cut(TRUE); // pushes B up
1099 continue;
1100 } else if (B->cp_ap->opc == RETRY_USERC_OPCODE && B->cp_b == ptr) {
1101 // started the current choicepoint, I hope
1102 return do_cut(TRUE);
1103 } else
1104 break; // oops, there is something else
1105 }
1106 if (!ptr || B < ptr) {
1107 // we're still not there yet
1108 choiceptr new = B;
1109 while (new &&new < ptr) {
1110 if (new->cp_ap == EXITCODE) /* separator */
1111 new->cp_ap = FAILCODE; // there are choice-points above but at least,
1112 // these won't harm innocent code
1113 else if (new->cp_ap->opc == RETRY_USERC_OPCODE && new->cp_b == ptr) {
1114 // I can't cut, but I can tag it as done
1115 new->cp_ap = FAILCODE; // there are choice-points above but at least,
1116 // these won't harm innocent code
1117 }
1118 new = new->cp_b;
1119 }
1120 }
1121 if (has_cp) {
1122 if (B == ptr) {
1123 return do_cut(TRUE);
1124 } else {
1125 ptr->cp_ap = FAILCODE;
1126 }
1127 }
1128 return TRUE;
1129}
1130
1131X_API Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
1132 BACKUP_MACHINE_REGS();
1133 CACHE_REGS
1134 Int ret;
1135 Int OASP = LCL0 - (CELL *)B;
1136 // Term omod = CurrentModule;
1137 // if (pe->PredFlags & CArgsPredFlag) {
1138 // CurrentModule = pe->ModuleOfPred;
1139 //}
1140 int lvl = push_text_stack();
1141 yhandle_t hdl = Yap_CurrentHandle();
1142 if (pe->PredFlags & SWIEnvPredFlag) {
1143 CPredicateV codev = (CPredicateV)exec_code;
1144 struct foreign_context ctx;
1145
1146 ctx.engine = NULL;
1147 yhandle_t s0 = Yap_InitSlots(pe->ArityOfPE, &ARG1);
1148 PP = pe;
1149 ret = codev(s0, 0, &ctx);
1150 } else if (pe->PredFlags & CArgsPredFlag) {
1151 PP = pe;
1152 ret = execute_cargs(pe, exec_code PASS_REGS);
1153 } else {
1154 PP = pe;
1155 ret = (exec_code)(PASS_REGS1);
1156 }
1157 PP = NULL;
1158 // check for junk: open frames, etc */
1159 if (ret)
1160 complete_exit(((choiceptr)(LCL0 - OASP)), FALSE, FALSE PASS_REGS);
1161 else {
1162 complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS);
1163 }
1164 Yap_RecoverHandles(0, hdl);
1165 pop_text_stack( lvl );
1166// CurrentModule = omod;
1167 RECOVER_MACHINE_REGS();
1168 if (!ret) {
1170 }
1171 return ret;
1172}
1173
1174#define FRG_REDO_MASK 0x00000003L
1175#define FRG_REDO_BITS 2
1176#define REDO_INT 0x02 /* Returned an integer */
1177#define REDO_PTR 0x03 /* returned a pointer */
1178
1179X_API Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
1180 CACHE_REGS
1181 CELL ocp = LCL0 - (CELL *)B;
1182 /* for slots to work */
1183 Int CurSlot = Yap_StartSlots();
1184 if (pe->PredFlags &
1185 (SWIEnvPredFlag | CArgsPredFlag | ModuleTransparentPredFlag)) {
1186 uintptr_t val;
1187 CPredicateV codev = (CPredicateV)exec_code;
1188 struct foreign_context *ctx =
1189 (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1));
1190
1191 PP = pe;
1192 ctx->control = FRG_FIRST_CALL;
1193 ctx->engine = NULL; //(PL_local_data *)Yap_regp;
1194 ctx->context = (uintptr_t)NULL;
1195 if (pe->PredFlags & CArgsPredFlag) {
1196 val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
1197 } else {
1198 val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx);
1199 }
1200 Yap_CloseSlots(CurSlot);
1201 PP = NULL;
1202 if (val == 0) {
1203 if (Yap_HasException()&& Yap_RaiseException()) {
1204 return false;
1205 }
1206 return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
1207 } else if (val == 1) { /* TRUE */
1208 return complete_exit(((choiceptr)(LCL0 - ocp)), TRUE, FALSE PASS_REGS);
1209 } else {
1210 if ((val & REDO_PTR) == REDO_PTR)
1211 ctx->context = (uintptr_t)(val & ~REDO_PTR);
1212 else
1213 ctx->context = (uintptr_t)((val & ~REDO_PTR) >> FRG_REDO_BITS);
1214 /* fix dropped cps */
1215 return complete_exit(((choiceptr)(LCL0 - ocp)), FALSE, FALSE PASS_REGS);
1216 }
1217 } else {
1218 Int ret = (exec_code)(PASS_REGS1);
1219 Yap_CloseSlots(CurSlot);
1220 if (!ret) {
1222 }
1223 return ret;
1224 }
1225}
1226
1227X_API Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
1228 struct cut_c_str *top) {
1229 CACHE_REGS
1230 Int oB = LCL0 - (CELL *)B;
1231 Int val;
1232 /* for slots to work */
1233 yhandle_t CurSlot = Yap_StartSlots();
1234 /* find out where we belong */
1235 while (B < (choiceptr)top) {
1236 oB = LCL0 - (CELL *)B;
1237 B = B->cp_b;
1238 }
1239 PP = pe;
1240 if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) {
1241 // SWI Emulation
1242 CPredicateV codev = (CPredicateV)exec_code;
1243 struct foreign_context *ctx =
1244 (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1));
1245 CELL *args = B->cp_args;
1246
1247 B = (choiceptr)(LCL0 - oB);
1248 ctx->control = FRG_CUTTED;
1249 ctx->engine = NULL; //(PL_local_data *)Yap_regp;
1250 if (pe->PredFlags & CArgsPredFlag) {
1251 val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
1252 } else {
1253 val = codev(Yap_InitSlots(pe->ArityOfPE, args), 0, ctx);
1254 }
1255 } else {
1256 Int oYENV = LCL0 - YENV;
1257 yamop *oP = P, *oCP = CP;
1258 // YAP Native
1259 B = (choiceptr)(LCL0 - oB);
1260 val = exec_code(PASS_REGS1);
1261 YENV = LCL0 - oYENV;
1262 P = oP;
1263 CP = oCP;
1264 }
1265 Yap_CloseSlots(CurSlot);
1266 PP = NULL;
1267 // B = LCL0-(CELL*)oB;
1268 if (!val && Yap_RaiseException()) {
1269 return false;
1270 } else { /* TRUE */
1271 return val;
1272 }
1273}
1274
1275X_API Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) {
1276 CACHE_REGS
1277 /* for slots to work */
1278 Yap_StartSlots();
1279 UInt ocp = LCL0 - (CELL *)B;
1280 if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) {
1281 Int val;
1282 CPredicateV codev = (CPredicateV)exec_code;
1283 struct foreign_context *ctx =
1284 (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1));
1285
1286 PP = pe;
1287 ctx->control = FRG_REDO;
1288 if (pe->PredFlags & CArgsPredFlag) {
1289 val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
1290 } else {
1291 val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx);
1292 }
1293 /* we are below the original choice point ?? */
1294 /* make sure we clean up the frames left by the user */
1295 PP = NULL;
1296 if (val == 0) {
1297 if (Yap_RaiseException()) {
1298 return FALSE;
1299 } else {
1300 return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
1301 }
1302 } else if (val == 1) { /* TRUE */
1303 return complete_exit(((choiceptr)(LCL0 - ocp)), TRUE, FALSE PASS_REGS);
1304 } else {
1305 if ((val & REDO_PTR) == REDO_PTR)
1306 ctx->context = (uintptr_t)(val & ~REDO_PTR);
1307 else
1308 ctx->context = (uintptr_t)((val & ~REDO_PTR) >> FRG_REDO_BITS);
1309 }
1310 /* fix dropped cps */
1311 return complete_exit(((choiceptr)(LCL0 - ocp)), FALSE, FALSE PASS_REGS);
1312 } else {
1313 Int ret = (exec_code)(PASS_REGS1);
1314 if (!ret) {
1316 }
1317 return ret;
1318 }
1319}
1320
1321X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) {
1322 CACHE_REGS
1323 void *new_ptr;
1324 BACKUP_MACHINE_REGS();
1325 while ((new_ptr = Yap_ReallocCodeSpace(ptr, size)) == NULL) {
1326 if (!Yap_growheap(FALSE, size, NULL)) {
1327 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
1328 return NULL;
1329 }
1330 }
1331 RECOVER_MACHINE_REGS();
1332 return new_ptr;
1333}
1334
1335X_API void *YAP_AllocSpaceFromYap(size_t size) {
1336 CACHE_REGS
1337 void *ptr;
1338 BACKUP_MACHINE_REGS();
1339
1340 while ((ptr = Yap_AllocCodeSpace(size)) == NULL) {
1341 if (!Yap_growheap(FALSE, size, NULL)) {
1342 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
1343 return NULL;
1344 }
1345 }
1346 RECOVER_MACHINE_REGS();
1347 return ptr;
1348}
1349
1350X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
1351
1352/* */
1362X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
1363 CACHE_REGS
1364 BACKUP_MACHINE_REGS();
1365 seq_tv_t inp, out;
1366 int l = push_text_stack();
1367 inp.val.t = t;
1368 inp.type = YAP_STRING_ATOMS_CODES | YAP_STRING_STRING | YAP_STRING_ATOM |
1369 YAP_STRING_TRUNC | YAP_STRING_MALLOC;
1370 inp.max = bufsize;
1371 out.type = YAP_STRING_CHARS;
1372 out.val.c = buf;
1373 out.enc = ENC_ISO_UTF8;
1374 if (!Yap_CVT_Text(&inp, &out PASS_REGS)) {
1375 pop_text_stack(l);
1376 RECOVER_MACHINE_REGS();
1377 return NULL;
1378 } else {
1379 RECOVER_MACHINE_REGS();
1380 if (buf == out.val.c) {
1381 return buf;
1382 } else {
1383 return pop_output_text_stack(l, out.val.c);
1384 }
1385 }
1386}
1387
1388/* copy a string to a buffer */
1389X_API Term YAP_BufferToString(const char *s) {
1390 Term t;
1391 BACKUP_H();
1392
1393 CACHE_REGS
1394 seq_tv_t inp, out;
1395 inp.val.c0 = s;
1396 inp.type = YAP_STRING_CHARS;
1397 out.type = YAP_STRING_CODES;
1398 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1399 return 0L;
1400 t = out.val.t;
1401
1402 RECOVER_H();
1403 return t;
1404}
1405
1406/* copy a string to a buffer */
1407X_API Term YAP_NBufferToString(const char *s, size_t len) {
1408 Term t;
1409 BACKUP_H();
1410
1411 CACHE_REGS
1412 seq_tv_t inp, out;
1413 inp.val.c0 = s;
1414 inp.type = YAP_STRING_CHARS;
1415 out.type = YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
1416 out.max = len;
1417 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1418 return 0L;
1419 t = out.val.t;
1420
1421 RECOVER_H();
1422 return t;
1423}
1424
1425/* copy a string to a buffer */
1426X_API Term YAP_WideBufferToString(const wchar_t *s) {
1427 Term t;
1428 BACKUP_H();
1429
1430 CACHE_REGS
1431 seq_tv_t inp, out;
1432 inp.val.w0 = s;
1433 inp.type = YAP_STRING_WCHARS;
1434 out.type = YAP_STRING_CODES;
1435 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1436 return 0L;
1437 t = out.val.t;
1438
1439 RECOVER_H();
1440 return t;
1441}
1442
1443/* copy a string to a buffer */
1444X_API Term YAP_NWideBufferToString(const wchar_t *s, size_t len) {
1445 Term t;
1446 BACKUP_H();
1447
1448 CACHE_REGS
1449 seq_tv_t inp, out;
1450 inp.val.w0 = s;
1451 inp.type = YAP_STRING_WCHARS;
1452 out.type = YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
1453 out.max = len;
1454 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1455 return 0L;
1456 t = out.val.t;
1457
1458 RECOVER_H();
1459 return t;
1460}
1461
1462/* copy a string to a buffer */
1463X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
1464 CACHE_REGS
1465 Term t;
1466 BACKUP_H();
1467
1468 LOCAL_ErrorMessage = NULL;
1469 while (!(t = Yap_BufferToTerm(s, TermNil))) {
1470 if (LOCAL_Error_TYPE) {
1471 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
1472 if (!Yap_dogc( PASS_REGS1)) {
1473 *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
1474 Yap_ThrowError(RESOURCE_ERROR_STACK, MkStringTerm(s),NULL);
1475 RECOVER_H();
1476 return 0L;
1477 }
1478 } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP) {
1479 if (!Yap_growheap(FALSE, 0, NULL)) {
1480 *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
1481 Yap_ThrowError(RESOURCE_ERROR_HEAP, MkStringTerm(s),NULL);
1482 RECOVER_H();
1483 return 0L;
1484 }
1485 } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) {
1486 if (!Yap_growtrail(0, FALSE)) {
1487 *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
1488 Yap_ThrowError(RESOURCE_ERROR_HEAP, MkStringTerm(s),NULL);
1489 RECOVER_H();
1490 return 0L;
1491 }
1492 } else {
1493 if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
1494 Yap_ThrowError(LOCAL_Error_TYPE , MkStringTerm(s), NULL);
1495 RECOVER_H();
1496 return 0L;
1497 }
1498 LOCAL_ErrorMessage = NULL;
1499 RECOVER_H();
1500 return 0;
1501 }
1502 } else {
1503 break;
1504 }
1505 }
1506 RECOVER_H();
1507 return t;
1508}
1509
1510/* copy a string to a buffer */
1511X_API YAP_Term YAP_BufferToAtomList(const char *s) {
1512 Term t;
1513 BACKUP_H();
1514
1515 CACHE_REGS
1516 seq_tv_t inp, out;
1517 inp.val.c0 = s;
1518 inp.type = YAP_STRING_CHARS;
1519 out.type = YAP_STRING_ATOMS;
1520 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1521 return 0L;
1522 t = out.val.t;
1523
1524 RECOVER_H();
1525 return t;
1526}
1527
1528/* copy a string of size len to a buffer */
1529X_API Term YAP_NBufferToAtomList(const char *s, size_t len) {
1530 Term t;
1531 BACKUP_H();
1532
1533 CACHE_REGS
1534 seq_tv_t inp, out;
1535 inp.val.c0 = s;
1536 inp.type = YAP_STRING_CHARS;
1537 out.type = YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
1538 out.max = len;
1539 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1540 return 0L;
1541 t = out.val.t;
1542
1543 RECOVER_H();
1544 return t;
1545}
1546
1547/* copy a string to a buffer */
1548X_API Term YAP_WideBufferToAtomList(const wchar_t *s) {
1549 Term t;
1550 BACKUP_H();
1551
1552 CACHE_REGS
1553 seq_tv_t inp, out;
1554 inp.val.w0 = s;
1555 inp.type = YAP_STRING_WCHARS;
1556 out.type = YAP_STRING_ATOMS;
1557 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1558 return 0L;
1559 t = out.val.t;
1560
1561 RECOVER_H();
1562 return t;
1563}
1564
1565/* copy a string of size len to a buffer */
1566X_API Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) {
1567 Term t;
1568 BACKUP_H();
1569
1570 CACHE_REGS
1571 seq_tv_t inp, out;
1572 inp.val.w0 = s;
1573 inp.type = YAP_STRING_WCHARS;
1574 out.type = YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
1575 out.max = len;
1576 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1577 return 0L;
1578 t = out.val.t;
1579
1580 RECOVER_H();
1581 return t;
1582}
1583
1584/* copy a string of size len to a buffer */
1585X_API Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0,
1586 size_t len) {
1587 Term t;
1588 BACKUP_H();
1589
1590 CACHE_REGS
1591 seq_tv_t inp, out;
1592 inp.val.w0 = s;
1593 inp.type = YAP_STRING_WCHARS;
1594 out.type =
1595 YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF;
1596 out.max = len;
1597 out.dif = t0;
1598 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1599 return 0L;
1600 t = out.val.t;
1601
1602 RECOVER_H();
1603 return t;
1604}
1605
1606/* copy a string to a buffer */
1607X_API Term YAP_BufferToDiffList(const char *s, Term t0) {
1608 Term t;
1609 BACKUP_H();
1610
1611 CACHE_REGS
1612 seq_tv_t inp, out;
1613 inp.val.c0 = s;
1614 inp.type = YAP_STRING_CHARS;
1615 out.type = YAP_STRING_CODES | YAP_STRING_DIFF;
1616 out.dif = t0;
1617 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1618 return 0L;
1619 t = out.val.t;
1620
1621 RECOVER_H();
1622 return t;
1623}
1624
1625/* copy a string of size len to a buffer */
1626X_API Term YAP_NBufferToDiffList(const char *s, Term t0, size_t len) {
1627 Term t;
1628 BACKUP_H();
1629
1630 CACHE_REGS
1631 seq_tv_t inp, out;
1632 inp.val.c0 = s;
1633 inp.type = YAP_STRING_CHARS;
1634 out.type =
1635 YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF;
1636 out.max = len;
1637 out.dif = t0;
1638 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1639 return 0L;
1640 t = out.val.t;
1641
1642 RECOVER_H();
1643 return t;
1644}
1645
1646/* copy a string to a buffer */
1647X_API Term YAP_WideBufferToDiffList(const wchar_t *s, Term t0) {
1648 Term t;
1649 BACKUP_H();
1650
1651 CACHE_REGS
1652 seq_tv_t inp, out;
1653 inp.val.w0 = s;
1654 inp.type = YAP_STRING_WCHARS;
1655 out.type = YAP_STRING_CODES | YAP_STRING_DIFF;
1656 out.dif = t0;
1657 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1658 return 0L;
1659 t = out.val.t;
1660
1661 RECOVER_H();
1662 return t;
1663}
1664
1665/* copy a string of size len to a buffer */
1666X_API Term YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len) {
1667 Term t;
1668 BACKUP_H();
1669
1670 CACHE_REGS
1671 seq_tv_t inp, out;
1672 inp.val.w0 = s;
1673 inp.type = YAP_STRING_WCHARS;
1674 out.type =
1675 YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF;
1676 out.max = len;
1677 out.dif = t0;
1678 if (!Yap_CVT_Text(&inp, &out PASS_REGS))
1679 return 0L;
1680 t = out.val.t;
1681
1682 RECOVER_H();
1683 return t;
1684}
1685
1686X_API void YAP_Error__(const char *file, const char *function, int lineno,int myerrno, Term t, const char *buf, ...) {
1687#define YAP_BUF_SIZE 512
1688 va_list ap;
1689 char tmpbuf[YAP_BUF_SIZE];
1690
1691 if (!myerrno)
1692 myerrno = SYSTEM_ERROR_INTERNAL;
1693 if (t == 0L)
1694 t = TermNil;
1695 if (buf != NULL) {
1696 va_start(ap, buf);
1697#if HAVE_VSNPRINTF
1698 (void)vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap);
1699#else
1700 (void)vsprintf(tmpbuf, buf, ap);
1701#endif
1702 va_end(ap);
1703 } else {
1704 tmpbuf[0] = '\0';
1705 }
1706 Yap_ThrowError__(file,function,lineno,myerrno, t, tmpbuf);
1707}
1708
1709X_API YAP_PredEntryPtr YAP_FunctorToPred(YAP_Functor func) {
1710 CACHE_REGS
1711 return RepPredProp(PredPropByFunc(func, CurrentModule));
1712}
1713
1714X_API YAP_PredEntryPtr YAP_AtomToPred(YAP_Atom at) {
1715 CACHE_REGS
1716 return RepPredProp(PredPropByAtom(at, CurrentModule));
1717}
1718
1719X_API YAP_PredEntryPtr YAP_FunctorToPredInModule(YAP_Functor func, Term mod) {
1720 return RepPredProp(PredPropByFunc(func, mod));
1721}
1722
1723X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) {
1724 return RepPredProp(PredPropByAtom(at, mod));
1725}
1726
1727/*
1728static int run_emulator(USES_REGS1) {
1729 int out;
1730
1731 out = Yap_absmi(0);
1732 LOCAL_PrologMode |= UserCCallMode;
1733 return out;
1734}
1735*/
1736
1737X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
1738 CACHE_REGS
1739 PredEntry *pe = ape;
1740 bool out;
1741 // fprintf(stderr,"1EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
1742 // Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
1743 // LOCAL_CurSlot);
1744
1745 BACKUP_MACHINE_REGS();
1746 dgi->lvl = push_text_stack();
1747 LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
1748 LOCAL_PrologMode = UserMode;
1749 dgi->p = P;
1750 dgi->cp = CP;
1751 dgi->b0 = LCL0 - (CELL *)B;
1752 dgi->env0 = LCL0 - ENV;
1753 // ensure our current ENV receives current P.
1754
1755 Yap_PrepGoal(pe->ArityOfPE, nullptr, B PASS_REGS);
1756 P = pe->CodeOfPred;
1757 // __android_log_print(ANDROID_LOG_INFO, "YAP ", "ap=%p %d %x %x args=%x,%x
1758 // slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2),
1759 // LOCAL_CurSlot);
1760 dgi->b_entry = LCL0 - (CELL *)B;
1761 dgi->h = HR - H0;
1762 dgi->tr = (CELL *)TR - LCL0;
1763 // fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
1764 // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
1765 out = Yap_exec_absmi(true, false);
1766 // fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
1767 // Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
1768 // LOCAL_CurSlot);
1769 dgi->b_exit = LCL0 - (CELL *)B;
1770 if (out) {
1771 dgi->EndSlot = LOCAL_CurSlot;
1772 Yap_StartSlots();
1773 } else {
1774 LOCAL_CurSlot =
1775 dgi->CurSlot; // ignore any slots created within the called goal
1776 }
1777 pop_text_stack(dgi->lvl);
1778 RECOVER_MACHINE_REGS();
1779 return out;
1780}
1781
1782X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
1783 CACHE_REGS
1784 choiceptr myB, myB0;
1785 bool out;
1786
1787 BACKUP_MACHINE_REGS();
1788 dgi->lvl = push_text_stack();
1789 myB = (choiceptr)(LCL0 - dgi->b_exit);
1790 myB0 = (choiceptr)(LCL0 - dgi->b_entry);
1791 CP = myB->cp_cp;
1792 /* sanity check */
1793 while (B < myB0) {
1794 if (B->cp_ap == TRUSTFAILCODE)
1795 B = B->cp_b;
1796 else if (B->cp_ap == FAILCODE)
1797 B = B->cp_b;
1798 else {
1799 if (B->cp_ap == NOCODE)
1800 B = B->cp_b;
1801 break;
1802 }
1803 }
1804 // fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
1805 // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
1806 P = FAILCODE;
1807 /* make sure we didn't leave live slots when we backtrack */
1808 ASP = (CELL *)B;
1809 LOCAL_CurSlot = dgi->EndSlot;
1810 out = Yap_exec_absmi(true, true );
1811 if (out) {
1812 dgi->EndSlot = LOCAL_CurSlot;
1813 dgi->b_exit = LCL0 - (CELL *)B;
1814 } else {
1815 printf("F %ld\n", dgi->CurSlot);
1816 LOCAL_CurSlot =
1817 dgi->CurSlot; // ignore any slots created within the called goal
1818 }
1819 pop_text_stack(dgi->lvl);
1820 RECOVER_MACHINE_REGS();
1821 return out;
1822}
1823
1824X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) {
1825 CACHE_REGS
1826
1827 // fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d
1828 // P=%p CP=%p Slots=%d\n",
1829 // successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP,
1830 // LOCAL_CurSlot);
1831 BACKUP_MACHINE_REGS();
1832
1833 dgi->lvl = push_text_stack();
1834 if (successful) {
1835 choiceptr nB = (choiceptr)(LCL0 - dgi->b_entry);
1836
1837 if (B <= nB) {
1838 B = nB;
1839 }
1840 Yap_TrimTrail();
1841 B = B->cp_b;
1842 } else if (LOCAL_PrologMode & AsyncIntMode) {
1843 Yap_signal(YAP_FAIL_SIGNAL);
1844 }
1845 B = (choiceptr)(LCL0 - dgi->b0);
1846#ifdef DEPTH_LIMIT
1847 DEPTH = B->cp_depth;
1848#endif
1849 P = dgi->p;
1850 CP = dgi->cp;
1851 YENV = ENV = LCL0-dgi->env0;
1852 LOCAL_CurSlot =
1853 dgi->CurSlot; // ignore any slots created within the called goal
1854 pop_text_stack(dgi->lvl);
1855 RECOVER_MACHINE_REGS();
1856 // fprintf(stderr," LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
1857 // Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P,
1858 // CP, LOCAL_CurSlot);
1859 return TRUE;
1860}
1861
1862X_API Int YAP_RunGoal(Term t) {
1863 CACHE_REGS
1864 Term out;
1865 yhandle_t cslot = LOCAL_CurSlot;
1866 BACKUP_MACHINE_REGS();
1867
1868int lvl = push_text_stack();
1869
1870 LOCAL_AllowRestart = FALSE;
1871 LOCAL_PrologMode = UserMode;
1872 out = Yap_RunTopGoal(t, true);
1873 LOCAL_PrologMode = UserCCallMode;
1874 // should we catch the exception or pass it through?
1875 // We'll pass it through
1876 RECOVER_MACHINE_REGS();
1877 LOCAL_CurSlot = cslot;
1878 pop_text_stack(lvl);
1879 return out;
1880}
1881
1882X_API Term YAP_AllocExternalDataInStack(size_t bytes) {
1883 CELL *pt;
1884 Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes, &pt);
1885 if (t == TermNil)
1886 return 0L;
1887 return t;
1888}
1889
1890X_API YAP_Bool YAP_IsExternalDataInStackTerm(Term t) {
1891 return IsExternalBlobTerm(t, EXTERNAL_BLOB);
1892}
1893
1894X_API void *YAP_ExternalDataInStackFromTerm(Term t) {
1895 return ExternalBlobFromTerm(t);
1896}
1897
1898X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
1899 int i;
1900 if (!GLOBAL_OpaqueHandlersCount) {
1901 GLOBAL_OpaqueHandlers =
1902 malloc(sizeof(YAP_opaque_handler_t) * USER_BLOB_END);
1903 if (!GLOBAL_OpaqueHandlers) {
1904 /* no room */
1905 return -1;
1906 }
1907 GLOBAL_OpaqueHandlersCount = USER_BLOB_START;
1908 } else if (GLOBAL_OpaqueHandlersCount == USER_BLOB_END) {
1909 /* all types used */
1910 return -1;
1911 }
1912 i = GLOBAL_OpaqueHandlersCount++;
1913 memmove(GLOBAL_OpaqueHandlers + i, f, sizeof(YAP_opaque_handler_t));
1914 return i;
1915}
1916
1917X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t blob_tag, size_t bytes) {
1918 CELL *pt;
1919 Term t = Yap_AllocExternalDataInStack((CELL)blob_tag, bytes, &pt);
1920 if (t == TermNil)
1921 return 0L;
1922 if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
1923 Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
1924 "clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
1925 return FALSE;
1926 }
1927 YAP_opaque_tag_t blob_info = blob_tag;
1928 if (GLOBAL_OpaqueHandlers[blob_info].cut_handler ||
1929 GLOBAL_OpaqueHandlers[blob_info].fail_handler) {
1930 *HR++ = t;
1931 *HR++ = TermNil;
1932 TrailTerm(TR) = AbsPair(HR - 2);
1933 }
1934 return t;
1935}
1936
1937X_API YAP_Bool YAP_IsOpaqueObjectTerm(Term t, YAP_opaque_tag_t tag) {
1938 return IsExternalBlobTerm(t, (CELL)tag);
1939}
1940
1941X_API void *YAP_OpaqueObjectFromTerm(Term t) { return ExternalBlobFromTerm(t); }
1942
1943X_API CELL *YAP_HeapStoreOpaqueTerm(Term t) {
1944 return Yap_HeapStoreOpaqueTerm(t);
1945}
1946
1947X_API Int YAP_RunGoalOnce(Term t) {
1948 CACHE_REGS
1949 Term out;
1950 yamop *old_CP = CP, *old_P = P;
1951 Int oldPrologMode = LOCAL_PrologMode;
1952 yhandle_t CSlot;
1953
1954 BACKUP_MACHINE_REGS();
1955 int lvl = push_text_stack();
1956 CSlot = Yap_StartSlots();
1957 LOCAL_PrologMode = UserMode;
1958 // Yap_heap_regs->yap_do_low_level_trace=true;
1959 LOCAL_AllowRestart = true;
1960 out = Yap_RunTopGoal(t, true);
1961 LOCAL_PrologMode = oldPrologMode;
1962 // Yap_CloseSlots(CSlot);
1963 if (!(oldPrologMode & UserCCallMode)) {
1964 /* called from top-level */
1965 pop_text_stack( lvl);
1966 LOCAL_AllowRestart = false;
1967 RECOVER_MACHINE_REGS();
1968 return out;
1969 }
1970 // should we catch the exception or pass it through?
1971 // We'll pass it through
1972 if (out) {
1973 choiceptr cut_pt, ob;
1974
1975 ob = NULL;
1976 cut_pt = B;
1977 while (cut_pt->cp_ap != NOCODE) {
1978 /* make sure we prune C-choicepoints */
1979 if (POP_CHOICE_POINT(cut_pt->cp_b)) {
1980 POP_EXECUTE();
1981 }
1982 ob = cut_pt;
1983 cut_pt = cut_pt->cp_b;
1984 }
1985#ifdef YAPOR
1986 CUT_prune_to(cut_pt);
1987#endif
1988 if (ob) {
1989 B = ob;
1990 Yap_TrimTrail();
1991 }
1992 B = cut_pt;
1993 } else {
1994 Yap_CloseSlots(CSlot);
1995 }
1996 ASP = B->cp_env;
1997 ENV = (CELL *)ASP[E_E];
1998 B = (choiceptr)ASP[E_CB];
1999#ifdef DEPTH_LIMIT
2000 DEPTH = ASP[E_DEPTH];
2001#endif
2002 P = old_P;
2003 CP = old_CP;
2004 if (Yap_RaiseException()) {
2005 /* called from top-level */
2006 pop_text_stack( lvl);
2007 LOCAL_AllowRestart = false;
2008 RECOVER_MACHINE_REGS();
2009 return false;
2010 }
2011 LOCAL_AllowRestart = false;
2012 RECOVER_MACHINE_REGS();
2013 pop_text_stack( lvl);
2014 return out;
2015}
2016
2017X_API bool YAP_RestartGoal(void) {
2018 CACHE_REGS
2019 BACKUP_MACHINE_REGS();
2020 bool out;
2021 if (LOCAL_AllowRestart) {
2022 P = (yamop *)FAILCODE;
2023 LOCAL_PrologMode = UserMode;
2024 out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
2025 LOCAL_PrologMode = UserCCallMode;
2026 if (out == FALSE) {
2027 /* cleanup */
2028 Yap_trust_last();
2029 LOCAL_AllowRestart = FALSE;
2030 }
2031 } else {
2032 out = FALSE;
2033 }
2034 RECOVER_MACHINE_REGS();
2035 return (out);
2036}
2037
2038X_API bool YAP_ShutdownGoal(int backtrack) {
2039 CACHE_REGS
2040 BACKUP_MACHINE_REGS();
2041
2042 if (LOCAL_AllowRestart) {
2043 choiceptr cut_pt;
2044
2045 cut_pt = B;
2046 while (cut_pt->cp_ap != NOCODE) {
2047 /* make sure we prune C-choicepoints */
2048 if (POP_CHOICE_POINT(cut_pt->cp_b)) {
2049 POP_EXECUTE();
2050 }
2051 cut_pt = cut_pt->cp_b;
2052 }
2053#ifdef YAPOR
2054 CUT_prune_to(cut_pt);
2055#endif
2056 /* just force backtrack */
2057 B = cut_pt;
2058 if (backtrack) {
2059 P = FAILCODE;
2060 Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
2061 /* recover stack space */
2062 HR = cut_pt->cp_h;
2063 TR = cut_pt->cp_tr;
2064 }
2065 /* we can always recover the stack */
2066 ASP = cut_pt->cp_env;
2067 ENV = (CELL *)ASP[E_E];
2068 B = (choiceptr)ASP[E_CB];
2069 Yap_TrimTrail();
2070#ifdef DEPTH_LIMIT
2071 DEPTH = ASP[E_DEPTH];
2072#endif
2073 LOCAL_AllowRestart = FALSE;
2074 }
2075 RECOVER_MACHINE_REGS();
2076 return TRUE;
2077}
2078
2079X_API bool YAP_ContinueGoal(void) {
2080 CACHE_REGS
2081 bool out;
2082 BACKUP_MACHINE_REGS();
2083
2084 LOCAL_PrologMode = UserMode;
2085 out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
2086 LOCAL_PrologMode = UserCCallMode;
2087
2088 RECOVER_MACHINE_REGS();
2089 return (out);
2090}
2091
2092X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) {
2093 CACHE_REGS
2094 BACKUP_B();
2095
2096 choiceptr myB = (choiceptr)(LCL0 - gi->b_entry);
2097 while (B != myB) {
2098 /* make sure we prune C-choicepoints */
2099 if (POP_CHOICE_POINT(B->cp_b)) {
2100 POP_EXECUTE();
2101 }
2102 if (!B->cp_b)
2103 break;
2104 B = B->cp_b;
2105 }
2106
2107 Yap_TrimTrail();
2108
2109 RECOVER_B();
2110}
2111
2112X_API bool YAP_GoalHasException(Term *t) {
2113 CACHE_REGS
2114 BACKUP_MACHINE_REGS();
2115 return LOCAL_ActiveError->errorNo != YAP_NO_ERROR;
2116}
2117
2118X_API void YAP_ClearExceptions(void) {
2119 CACHE_REGS
2120
2121 Yap_ResetException(worker_id);
2122}
2123
2124X_API int YAP_InitConsult(int mode, const char *fname, char *full,
2125 int *osnop) {
2126 CACHE_REGS
2127
2128 int sno;
2129 int lvl = push_text_stack();
2130 BACKUP_MACHINE_REGS();
2131 const char *fl = NULL;
2132 if (mode == YAP_BOOT_MODE) {
2133 mode = YAP_CONSULT_MODE;
2134 }
2135 if (fname == NULL || fname[0] == '\0') {
2136 extern char * Yap_SOURCEBOOT;
2137 fl = Yap_SOURCEBOOT;
2138 }
2139 if (!fname || !(fl = Yap_AbsoluteFile(fname, true)) || !fl[0]) {
2140 __android_log_print(
2141 ANDROID_LOG_INFO, "YAPDroid", "failed ABSOLUTEFN %s ", fl);
2142 if (full) full[0] = '\0';
2143 pop_text_stack(lvl);
2144 return -1;
2145 }
2146 __android_log_print(
2147 ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",fl);
2148 char *d = Malloc(strlen(fl) + 1);
2149 strcpy(d, fl);
2150 bool consulted = (mode == YAP_CONSULT_MODE);
2151 Term tat = MkAtomTerm(Yap_LookupAtom(d));
2152 sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)),
2153 LOCAL_encoding);
2154 __android_log_print(
2155 ANDROID_LOG_INFO, "YAPDroid", "OpenStream got %d ",sno);
2156 if (sno < 0 || !Yap_ChDir(dirname((char *)d))) {
2157 if (full) full[0] = '\0';
2158 pop_text_stack(lvl);
2159 return -1;
2160 }
2161 LOCAL_PrologMode = UserMode;
2162 strcpy(full, fl);
2163 Yap_init_consult(consulted,full);
2164 RECOVER_MACHINE_REGS();
2165 UNLOCK(GLOBAL_Stream[sno].streamlock);
2166 pop_text_stack(lvl);
2167 return sno;
2168}
2169
2172X_API void *YAP_GetStreamFromId(int no) { return GLOBAL_Stream + no; }
2173
2174X_API FILE *YAP_TermToStream(Term t) {
2175 BACKUP_MACHINE_REGS();
2176 FILE *s;
2177
2178 if (IsVarTerm(t) || !IsAtomTerm(t))
2179 return NULL;
2180 if ((s = Yap_GetStreamHandle(t)->file)) {
2181 RECOVER_MACHINE_REGS();
2182 return s;
2183 }
2184 RECOVER_MACHINE_REGS();
2185 return NULL;
2186}
2187
2188X_API void YAP_EndConsult(int sno, int *osnop, const char *full) {
2189 BACKUP_MACHINE_REGS();
2190 Yap_CloseStream(sno);
2191 int lvl = push_text_stack();
2192 char *d = Malloc(strlen(full) + 1);
2193 strcpy(d, full);
2194 Yap_ChDir(dirname(d));
2195 Yap_end_consult();
2196 __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d",
2197 CurrentModule == 0
2198 ? "prolog"
2199 : RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
2200 full, *osnop, sno);
2201 // LOCAL_CurSlot);
2202 pop_text_stack(lvl);
2203 RECOVER_MACHINE_REGS();
2204}
2205
2206X_API Term YAP_Read(FILE *f) {
2207 Term o;
2208 int sno = Yap_FileStream(f, NULL, TermNil, Input_Stream_f, NULL);
2209
2210 BACKUP_MACHINE_REGS();
2211 o = Yap_read_term(sno, TermNil, 1);
2212 Yap_CloseStream( sno);
2213 RECOVER_MACHINE_REGS();
2214 return o;
2215}
2216
2217X_API Term YAP_ReadFromStream(int sno) {
2218 Term o;
2219
2220 BACKUP_MACHINE_REGS();
2221
2222 sigjmp_buf signew;
2223 if (sigsetjmp(signew, 0)) {
2224 Yap_syntax_error(LOCAL_toktide, sno, "ReadFromStream");
2225 RECOVER_MACHINE_REGS();
2226 return 0;
2227 } else {
2228 o = Yap_read_term(sno, TermNil, false);
2229 }
2230 RECOVER_MACHINE_REGS();
2231 return o;
2232}
2233
2234X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
2235
2236 BACKUP_MACHINE_REGS();
2237 Term t = Yap_read_term(
2238 sno,
2239 MkPairTerm(
2240 Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
2241 MkPairTerm(
2242 Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
2243 1, &pos),
2244 TermNil)),
2245 true);
2246 RECOVER_MACHINE_REGS();
2247 return t;
2248}
2249
2250X_API void YAP_Write(Term t, FILE *f, int flags) {
2251 BACKUP_MACHINE_REGS();
2252 int sno = Yap_FileStream(f, NULL, TermNil, Output_Stream_f, NULL);
2253
2254 Yap_plwrite(t, GLOBAL_Stream + sno, 0, HR, flags, NULL);
2255 Yap_CloseStream(sno);
2256
2257 RECOVER_MACHINE_REGS();
2258}
2259
2260X_API YAP_Term YAP_CopyTerm(Term t) {
2261 Term tn;
2262 BACKUP_MACHINE_REGS();
2263
2264 tn = Yap_CopyTerm(t);
2265
2266 RECOVER_MACHINE_REGS();
2267
2268 return (tn);
2269}
2270
2271X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) {
2272 CACHE_REGS
2273 seq_tv_t inp, out;
2274
2275 BACKUP_MACHINE_REGS();
2276 int l = push_text_stack();
2277 inp.val.t = t;
2278 inp.type = YAP_STRING_TERM | YAP_STRING_DATUM;
2279 out.type = YAP_STRING_CHARS;
2280 out.val.c = NULL;
2281 out.max = sze - 1;
2282 out.enc = LOCAL_encoding;
2283 if (!Yap_CVT_Text(&inp, &out PASS_REGS)) {
2284 RECOVER_MACHINE_REGS();
2285 pop_text_stack(l);
2286 return NULL;
2287 } else {
2288 RECOVER_MACHINE_REGS();
2289 if (buf == out.val.c) {
2290 pop_text_stack(l);
2291 return buf;
2292 } else {
2293 if ( strlen(out.val.c ) < sze) {
2294 strcpy( buf, out.val.c);
2295 pop_text_stack(l);
2296 return buf;
2297 }
2298 }
2299 }
2300 return out.val.c = pop_output_text_stack(l,buf);
2301}
2302
2305X_API char * YAP_WriteDynamicBuffer(YAP_Term t,
2306 encoding_t enc, int flags) {
2307 char *b;
2308
2309 BACKUP_MACHINE_REGS();
2310 b = Yap_TermToBuffer(t, flags);
2311 RECOVER_MACHINE_REGS();
2312 return b;
2313}
2314
2315X_API bool YAP_CompileClause(Term t) {
2316 CACHE_REGS
2317 yamop *codeaddr;
2318 Term mod = CurrentModule;
2319 Term tn = TermNil;
2320 bool ok = true;
2321
2322 BACKUP_MACHINE_REGS();
2323
2324 /* allow expansion during stack initialization */
2325 LOCAL_ErrorMessage = NULL;
2326 ARG1 = t;
2327 YAPEnterCriticalSection();
2328 codeaddr = Yap_cclause(t, 0, mod, t);
2329 ok = (codeaddr != NULL);
2330 if (ok) {
2331 t = Deref(ARG1); /* just in case there was an heap overflow */
2332 if (!Yap_addclause(t, codeaddr, TermAssertz, mod, &tn)) {
2333 ok = false;
2334 }
2335 } else {
2336 ok = false;
2337 }
2338 YAPLeaveCriticalSection();
2339
2340 if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
2341 if (!Yap_locked_growheap(FALSE, 0, NULL)) {
2342 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
2343 LOCAL_ErrorMessage);
2344 ok = false;
2345 }
2346 }
2347 RECOVER_MACHINE_REGS();
2348 if (!ok) {
2349 return NULL;
2350 }
2351 return ok;
2352}
2353
2354X_API void YAP_PutValue(YAP_Atom at, Term t) { Yap_PutValue(at, t); }
2355
2356X_API Term YAP_GetValue(YAP_Atom at) { return (Yap_GetValue(at)); }
2357
2358X_API int YAP_CompareTerms(Term t1, Term t2) {
2359 return Yap_compare_terms(t1, t2);
2360}
2361
2362X_API int YAP_Reset(yap_reset_t mode, bool reset_global) {
2363 int res = TRUE;
2364 BACKUP_MACHINE_REGS();
2365 res = Yap_Reset(mode, reset_global);
2366 RECOVER_MACHINE_REGS();
2367 return res;
2368}
2369
2370X_API void YAP_Exit(int retval) { Yap_exit(retval); }
2371
2372X_API int YAP_InitSocks(const char *host, long port) { return 0; }
2373
2374X_API void YAP_SetOutputMessage(void) {
2375#if DEBUG
2376 Yap_output_msg = TRUE;
2377#endif
2378}
2379
2380X_API int YAP_StreamToFileNo(Term t) { return (Yap_StreamToFileNo(t)); }
2381
2387X_API void *YAP_RepStreamFromId(int sno) { return GLOBAL_Stream + sno; }
2388
2389X_API void YAP_CloseAllOpenStreams(void) {
2390 BACKUP_H();
2391
2392 Yap_CloseStreams();
2393
2394 RECOVER_H();
2395}
2396
2397X_API void YAP_FlushAllStreams(void) {
2398 BACKUP_H();
2399
2400 // VSC?? Yap_FlushStreams();
2401
2402 RECOVER_H();
2403}
2404
2405X_API void YAP_Throw(Term t) {
2406 BACKUP_MACHINE_REGS();
2407 Yap_ThrowError(THROW_EVENT, t, NULL );
2408 RECOVER_MACHINE_REGS();
2409}
2410
2411X_API void YAP_AsyncThrow(Term t) {
2412 CACHE_REGS
2413 BACKUP_MACHINE_REGS();
2414 LOCAL_PrologMode |= AsyncIntMode;
2415 Yap_ThrowError(THROW_EVENT, t, NULL );
2416 LOCAL_PrologMode &= ~AsyncIntMode;
2417 RECOVER_MACHINE_REGS();
2418}
2419
2420X_API void YAP_Halt(int i) { Yap_exit(i); }
2421
2422X_API CELL *YAP_TopOfLocalStack(void) {
2423 CACHE_REGS
2424 return (ASP);
2425}
2426
2427X_API void *YAP_Predicate(YAP_Atom a, UInt arity, Term m) {
2428 if (arity == 0) {
2429 return ((void *)RepPredProp(PredPropByAtom(a, m)));
2430 } else {
2431 Functor f = Yap_MkFunctor(a, arity);
2432 return ((void *)RepPredProp(PredPropByFunc(f, m)));
2433 }
2434}
2435
2436X_API void YAP_PredicateInfo(void *p, YAP_Atom *a, UInt *arity, Term *m) {
2437 PredEntry *pd = (PredEntry *)p;
2438 if (pd->ArityOfPE) {
2439 *arity = pd->ArityOfPE;
2440 *a = NameOfFunctor(pd->FunctorOfPred);
2441 } else {
2442 *arity = 0;
2443 *a = (Atom)(pd->FunctorOfPred);
2444 }
2445 if (pd->ModuleOfPred)
2446 *m = pd->ModuleOfPred;
2447 else
2448 *m = TermProlog;
2449}
2450
2451X_API void YAP_UserCPredicate(const char *name, YAP_UserCPred def,
2452 YAP_Arity arity) {
2453 Yap_InitCPred(name, arity, (CPredicate)def, UserCPredFlag);
2454}
2455
2456X_API void YAP_UserBackCPredicate_(const char *name, YAP_UserCPred init,
2457 YAP_UserCPred cont, YAP_Arity arity,
2458 YAP_Arity extra) {
2459 Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont,
2460 NULL, UserCPredFlag);
2461}
2462
2463X_API void YAP_UserBackCutCPredicate(const char *name, YAP_UserCPred init,
2464 YAP_UserCPred cont, YAP_UserCPred cut,
2465 YAP_Arity arity, YAP_Arity extra) {
2466 Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont,
2467 (CPredicate)cut, UserCPredFlag);
2468}
2469
2470X_API void YAP_UserBackCPredicate(const char *name, YAP_UserCPred init,
2471 YAP_UserCPred cont, arity_t arity,
2472 arity_t extra) {
2473 Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont,
2474 NULL, UserCPredFlag);
2475}
2476
2477X_API void YAP_UserCPredicateWithArgs(const char *a, YAP_UserCPred f,
2478 arity_t arity, Term mod) {
2479 CACHE_REGS
2480 Term cm = CurrentModule;
2481 CurrentModule = mod;
2482 Yap_InitCPred(a, arity, (CPredicate)f, UserCPredFlag | CArgsPredFlag);
2483 CurrentModule = cm;
2484}
2485
2486X_API Term YAP_CurrentModule(void) {
2487 CACHE_REGS
2488 return (CurrentModule);
2489}
2490
2491X_API Term YAP_SetCurrentModule(Term new) {
2492 CACHE_REGS
2493 Term omod = CurrentModule;
2494 LOCAL_SourceModule = CurrentModule = new;
2495 return omod;
2496}
2497
2498X_API Term YAP_CreateModule(YAP_Atom at) {
2499 Term t;
2500 WRITE_LOCK(RepAtom(at)->ARWLock);
2501 t = Yap_Module(MkAtomTerm(at));
2502 WRITE_UNLOCK(RepAtom(at)->ARWLock);
2503 return t;
2504}
2505
2506X_API Term YAP_StripModule(Term t, Term *modp) {
2507 return Yap_StripModule(t, modp);
2508}
2509
2510X_API int YAP_ThreadSelf(void) {
2511#if THREADS
2512 return Yap_thread_self();
2513#else
2514 return -2;
2515#endif
2516}
2517
2518X_API int YAP_ThreadCreateEngine(struct YAP_thread_attr_struct *attr) {
2519#if THREADS
2520 return Yap_thread_create_engine(attr);
2521#else
2522 return -1;
2523#endif
2524}
2525
2526X_API int YAP_ThreadAttachEngine(int wid) {
2527#if THREADS
2528 return Yap_thread_attach_engine(wid);
2529#else
2530 return FALSE;
2531#endif
2532}
2533
2534X_API int YAP_ThreadDetachEngine(int wid) {
2535#if THREADS
2536 return Yap_thread_detach_engine(wid);
2537#else
2538 return FALSE;
2539#endif
2540}
2541
2542X_API int YAP_ThreadDestroyEngine(int wid) {
2543#if THREADS
2544 return Yap_thread_destroy_engine(wid);
2545#else
2546 return FALSE;
2547#endif
2548}
2549
2550X_API Term YAP_TermNil(void) { return TermNil; }
2551
2552X_API int YAP_IsTermNil(Term t) { return t == TermNil; }
2553
2554X_API int YAP_AtomGetHold(YAP_Atom at) { return Yap_AtomIncreaseHold(at); }
2555
2556X_API int YAP_AtomReleaseHold(YAP_Atom at) { return Yap_AtomDecreaseHold(at); }
2557
2558X_API YAP_agc_hook YAP_AGCRegisterHook(YAP_agc_hook hook) {
2559 YAP_agc_hook old = (YAP_agc_hook)GLOBAL_AGCHook;
2560 GLOBAL_AGCHook = (Agc_hook)hook;
2561 return old;
2562}
2563
2564X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) {
2565 return Yap_HaltRegisterHook(hook, closure);
2566}
2567
2568X_API char *YAP_cwd(void) {
2569 CACHE_REGS
2570 char *buf = Yap_AllocCodeSpace(FILENAME_MAX + 1);
2571 int len;
2572 if (!Yap_getcwd(buf, FILENAME_MAX))
2573 return FALSE;
2574 len = strlen(buf);
2575 buf = Yap_ReallocCodeSpace(buf, len + 1);
2576 return buf;
2577}
2578
2579X_API Term YAP_FloatsToList(double *dblp, size_t sz) {
2580 CACHE_REGS
2581 Term t;
2582 CELL *oldH;
2583 BACKUP_H();
2584
2585 if (!sz)
2586 return TermNil;
2587 while (ASP - 1024 < HR + sz * (2 + 2 + SIZEOF_DOUBLE / SIZEOF_INT_P)) {
2588 if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
2589 /* we are in trouble */
2590 LOCAL_OpenArray = (CELL *)dblp;
2591 }
2592 if (!Yap_dogc( PASS_REGS1)) {
2593 RECOVER_H();
2594 return 0L;
2595 }
2596 dblp = (double *)LOCAL_OpenArray;
2597 LOCAL_OpenArray = NULL;
2598 }
2599 t = AbsPair(HR);
2600 while (sz) {
2601 oldH = HR;
2602 HR += 2;
2603 oldH[0] = MkFloatTerm(*dblp++);
2604 oldH[1] = AbsPair(HR);
2605 sz--;
2606 }
2607 oldH[1] = TermNil;
2608 RECOVER_H();
2609 return t;
2610}
2611
2612X_API Int YAP_ListToFloats(Term t, double *dblp, size_t sz) {
2613 size_t i = 0;
2614
2615 t = Deref(t);
2616 do {
2617 Term hd;
2618 if (IsVarTerm(t))
2619 return -1;
2620 if (t == TermNil)
2621 return i;
2622 if (!IsPairTerm(t))
2623 return -1;
2624 hd = HeadOfTerm(t);
2625 if (IsFloatTerm(hd)) {
2626 dblp[i++] = FloatOfTerm(hd);
2627 } else {
2628 extern double Yap_gmp_to_float(Term hd);
2629
2630 if (IsIntTerm(hd))
2631 dblp[i++] = IntOfTerm(hd);
2632 else if (IsLongIntTerm(hd))
2633 dblp[i++] = LongIntOfTerm(hd);
2634 else if (IsBigIntTerm(hd))
2635 dblp[i++] = Yap_gmp_to_float(hd);
2636 else
2637 return -1;
2638 }
2639 if (i == sz)
2640 return sz;
2641 t = TailOfTerm(t);
2642 } while (TRUE);
2643}
2644
2645X_API Term YAP_IntsToList(Int *dblp, size_t sz) {
2646 CACHE_REGS
2647 Term t;
2648 CELL *oldH;
2649 BACKUP_H();
2650
2651 if (!sz)
2652 return TermNil;
2653 while (ASP - 1024 < HR + sz * 3) {
2654 if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
2655 /* we are in trouble */
2656 LOCAL_OpenArray = (CELL *)dblp;
2657 }
2658 if (!Yap_dogc(PASS_REGS1)) {
2659 RECOVER_H();
2660 return 0L;
2661 }
2662 dblp = (Int *)LOCAL_OpenArray;
2663 LOCAL_OpenArray = NULL;
2664 }
2665 t = AbsPair(HR);
2666 while (sz) {
2667 oldH = HR;
2668 HR += 2;
2669 oldH[0] = MkIntegerTerm(*dblp++);
2670 oldH[1] = AbsPair(HR);
2671 sz--;
2672 }
2673 oldH[1] = TermNil;
2674 RECOVER_H();
2675 return t;
2676}
2677
2678X_API Int YAP_ListToInts(Term t, Int *dblp, size_t sz) {
2679 size_t i = 0;
2680
2681 t = Deref(t);
2682 do {
2683 Term hd;
2684 if (IsVarTerm(t))
2685 return -1;
2686 if (t == TermNil)
2687 return i;
2688 if (!IsPairTerm(t))
2689 return -1;
2690 hd = HeadOfTerm(t);
2691 if (!IsIntTerm(hd))
2692 return -1;
2693 dblp[i++] = IntOfTerm(hd);
2694 if (i == sz)
2695 return sz;
2696 t = TailOfTerm(t);
2697 } while (TRUE);
2698}
2699
2700X_API Term YAP_OpenList(int n) {
2701 CACHE_REGS
2702 Term t;
2703 BACKUP_H();
2704
2705 while (HR + 2 * n > ASP - 1024) {
2706 if (!Yap_dogc( PASS_REGS1)) {
2707 RECOVER_H();
2708 return FALSE;
2709 }
2710 }
2711 t = AbsPair(HR);
2712 HR += 2 * n;
2713
2714 RECOVER_H();
2715 return t;
2716}
2717
2718X_API Term YAP_ExtendList(Term t0, Term inp) {
2719 Term t;
2720 CELL *ptr = RepPair(t0);
2721 BACKUP_H();
2722
2723 ptr[0] = inp;
2724 ptr[1] = AbsPair(ptr + 2);
2725 t = AbsPair(ptr + 2);
2726
2727 RECOVER_H();
2728 return t;
2729}
2730
2731X_API int YAP_CloseList(Term t0, Term tail) {
2732 CELL *ptr = RepPair(t0);
2733
2734 RESET_VARIABLE(ptr - 1);
2735 if (!Yap_unify((Term)(ptr - 1), tail))
2736 return FALSE;
2737 return TRUE;
2738}
2739
2740X_API int YAP_IsAttVar(Term t) {
2741 CACHE_REGS
2742 t = Deref(t);
2743 if (!IsVarTerm(t))
2744 return FALSE;
2745 return IsAttVar(VarOfTerm(t));
2746}
2747
2748X_API Term YAP_AttsOfVar(Term t) {
2749 CACHE_REGS
2750 attvar_record *attv;
2751
2752 t = Deref(t);
2753 if (!IsVarTerm(t))
2754 return TermNil;
2755 if (!IsAttVar(VarOfTerm(t)))
2756 return TermNil;
2757 attv = RepAttVar(VarOfTerm(t));
2758 return attv->Atts;
2759}
2760
2761X_API int YAP_FileNoFromStream(Term t) {
2762
2763 t = Deref(t);
2764 if (IsVarTerm(t))
2765 return -1;
2766 return Yap_StreamToFileNo(t);
2767}
2768
2769X_API void *YAP_FileDescriptorFromStream(Term t) {
2770
2771 t = Deref(t);
2772 if (IsVarTerm(t))
2773 return NULL;
2774 return Yap_FileDescriptorFromStream(t);
2775}
2776
2777X_API void *YAP_Record(Term t) {
2778 DBTerm *dbterm;
2779 DBRecordList *dbt;
2780
2781 dbterm = Yap_StoreTermInDB(Deref(t), 0);
2782 if (dbterm == NULL)
2783 return NULL;
2784 dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list));
2785 while (dbt == NULL) {
2786 if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) {
2787 /* be a good neighbor */
2788 Yap_FreeCodeSpace((void *)dbterm);
2789 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "using YAP_Record");
2790 return NULL;
2791 }
2792 }
2793 if (Yap_Records) {
2794 Yap_Records->prev_rec = dbt;
2795 }
2796 dbt->next_rec = Yap_Records;
2797 dbt->prev_rec = NULL;
2798 dbt->dbrecord = dbterm;
2799 Yap_Records = dbt;
2800 return dbt;
2801}
2802
2803X_API Term YAP_Recorded(void *handle) {
2804 CACHE_REGS
2805 Term t;
2806 DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord;
2807
2808 BACKUP_MACHINE_REGS();
2809 do {
2810 LOCAL_Error_TYPE = YAP_NO_ERROR;
2811 t = Yap_FetchTermFromDB(dbterm);
2812 if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
2813 RECOVER_MACHINE_REGS();
2814 return t;
2815 } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
2816 LOCAL_Error_TYPE = YAP_NO_ERROR;
2817 if (!Yap_growglobal(NULL)) {
2818 Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
2819 LOCAL_ErrorMessage);
2820 RECOVER_MACHINE_REGS();
2821 return FALSE;
2822 }
2823 } else {
2824 LOCAL_Error_TYPE = YAP_NO_ERROR;
2825 if (!Yap_growstack(dbterm->NOfCells * CellSize)) {
2826 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
2827 RECOVER_MACHINE_REGS();
2828 return FALSE;
2829 }
2830 }
2831 } while (t == (CELL)0);
2832 RECOVER_MACHINE_REGS();
2833 return t;
2834}
2835
2836X_API int YAP_Erase(void *handle) {
2837 DBRecordList *dbr = (DBRecordList *)handle;
2838 if (dbr->next_rec)
2839 dbr->next_rec->prev_rec = dbr->prev_rec;
2840 if (dbr->prev_rec)
2841 dbr->prev_rec->next_rec = dbr->next_rec;
2842 else if (Yap_Records == dbr) {
2843 Yap_Records = dbr->next_rec;
2844 }
2845 Yap_ReleaseTermFromDB(dbr->dbrecord);
2846 Yap_FreeCodeSpace(handle);
2847 return 1;
2848}
2849
2850X_API yhandle_t YAP_ArgsToSlots(int n) {
2851 CACHE_REGS
2852 return Yap_NewSlots(n);
2853}
2854
2855X_API void YAP_SlotsToArgs(int n, yhandle_t slot) {
2856 CACHE_REGS
2857 CELL *ptr0 = Yap_AddressFromSlot(slot), *ptr1 = &ARG1;
2858 while (n--) {
2859 *ptr1++ = *ptr0++;
2860 }
2861}
2862
2863X_API void YAP_signal(int sig) { Yap_signal(sig); }
2864
2865X_API int YAP_SetYAPFlag(Term flag, Term val) { return Yap_set_flag(flag, val); }
2866
2867/* yhandle_t YAP_VarSlotToNumber(yhandle_t) */
2868X_API yhandle_t YAP_VarSlotToNumber(yhandle_t s) {
2869 CACHE_REGS
2870 Term *t = (CELL *)Deref(Yap_GetFromSlot(s));
2871 if (t < HR)
2872 return t - H0;
2873 return t - LCL0;
2874}
2875
2876/* Term YAP_ModuleUser() */
2877X_API Term YAP_ModuleUser(void) { return MkAtomTerm(AtomUser); }
2878
2879/* int YAP_PredicateHasClauses() */
2880X_API YAP_handle_t YAP_NumberOfClausesForPredicate(YAP_PredEntryPtr ape) {
2881 PredEntry *pe = ape;
2882 return pe->cs.p_code.NOfClauses;
2883}
2884
2885X_API int YAP_MaxOpPriority(YAP_Atom at, Term module) {
2886 AtomEntry *ae = RepAtom(at);
2887 OpEntry *info;
2888 WRITE_LOCK(ae->ARWLock);
2889 info = Yap_GetOpPropForAModuleHavingALock(ae, module);
2890 if (!info) {
2891 WRITE_UNLOCK(ae->ARWLock);
2892 return 0;
2893 }
2894 int ret = info->Prefix;
2895 if (info->Infix > ret)
2896 ret = info->Infix;
2897 if (info->Posfix > ret)
2898 ret = info->Posfix;
2899 WRITE_UNLOCK(ae->ARWLock);
2900 return ret;
2901}
2902
2903X_API int YAP_OpInfo(YAP_Atom at, Term module, int opkind, int *yap_type,
2904 int *prio) {
2905 AtomEntry *ae = RepAtom(at);
2906 OpEntry *info;
2907 int n;
2908
2909 WRITE_LOCK(ae->ARWLock);
2910 info = Yap_GetOpPropForAModuleHavingALock(ae, module);
2911 if (!info) {
2912 /* try system operators */
2913 info = Yap_GetOpPropForAModuleHavingALock(ae, PROLOG_MODULE);
2914 if (!info) {
2915 WRITE_UNLOCK(ae->ARWLock);
2916 return 0;
2917 }
2918 }
2919 if (opkind == PREFIX_OP) {
2920 SMALLUNSGN p = info->Prefix;
2921 if (!p) {
2922 WRITE_UNLOCK(ae->ARWLock);
2923 return FALSE;
2924 }
2925 if (p & DcrrpFlag) {
2926 n = 6;
2927 *prio = (p ^ DcrrpFlag);
2928 } else {
2929 n = 7;
2930 *prio = p;
2931 }
2932 } else if (opkind == INFIX_OP) {
2933 SMALLUNSGN p = info->Infix;
2934 if (!p) {
2935 WRITE_UNLOCK(ae->ARWLock);
2936 return FALSE;
2937 }
2938 if ((p & DcrrpFlag) && (p & DcrlpFlag)) {
2939 n = 1;
2940 *prio = (p ^ (DcrrpFlag | DcrlpFlag));
2941 } else if (p & DcrrpFlag) {
2942 n = 3;
2943 *prio = (p ^ DcrrpFlag);
2944 } else if (p & DcrlpFlag) {
2945 n = 2;
2946 *prio = (p ^ DcrlpFlag);
2947 } else {
2948 n = 4;
2949 *prio = p;
2950 }
2951 } else {
2952 SMALLUNSGN p = info->Posfix;
2953 if (p & DcrlpFlag) {
2954 n = 4;
2955 *prio = (p ^ DcrlpFlag);
2956 } else {
2957 n = 5;
2958 *prio = p;
2959 }
2960 }
2961 *yap_type = n;
2962 WRITE_UNLOCK(ae->ARWLock);
2963 return 1;
2964}
2965
2966X_API int YAP_Argv(char ***argvp) {
2967 if (argvp) {
2968 *argvp = GLOBAL_argv;
2969 }
2970 return GLOBAL_argc;
2971}
2972
2973X_API YAP_tag_t YAP_TagOfTerm(Term t) {
2974 if (IsVarTerm(t)) {
2975 CELL *pt = VarOfTerm(t);
2976 if (IsUnboundVar(pt)) {
2977 CACHE_REGS
2978 if (IsAttVar(pt))
2979 return YAP_TAG_ATT;
2980 return YAP_TAG_UNBOUND;
2981 }
2982 return YAP_TAG_REF;
2983 }
2984 if (IsPairTerm(t))
2985 return YAP_TAG_PAIR;
2986 if (IsAtomOrIntTerm(t)) {
2987 if (IsAtomTerm(t))
2988 return YAP_TAG_ATOM;
2989 return YAP_TAG_INT;
2990 } else {
2991 Functor f = FunctorOfTerm(t);
2992
2993 if (IsExtensionFunctor(f)) {
2994 if (f == FunctorDBRef) {
2995 return YAP_TAG_DBREF;
2996 }
2997 if (f == FunctorLongInt) {
2998 return YAP_TAG_LONG_INT;
2999 }
3000 if (f == FunctorBigInt) {
3001 big_blob_type bt = RepAppl(t)[1];
3002 switch (bt) {
3003 case BIG_INT:
3004 return YAP_TAG_BIG_INT;
3005 case BIG_RATIONAL:
3006 return YAP_TAG_RATIONAL;
3007 default:
3008 return YAP_TAG_OPAQUE;
3009 }
3010 return YAP_TAG_OPAQUE;
3011 }
3012 }
3013 return YAP_TAG_APPL;
3014 }
3015}
3016
3017X_API void *YAP_PointerOfTerm(Term t) {
3018 if (IsVarTerm(t)) {
3019 Yap_ThrowError(INSTANTIATION_ERROR, t, NULL);
3020 return NULL;
3021 } else if (!IsIntegerTerm(t)) {
3022 Yap_ThrowError(TYPE_ERROR_INTEGER, t, NULL);
3023 return NULL;
3024 } else {
3025 return (void *)IntegerOfTerm(t);
3026 }
3027}
3028
3029int YAP_BPROLOG_exception;
3030Term YAP_BPROLOG_curr_toam_status;
3031
3041X_API size_t YAP_UTF8_TextLength(Term t) {
3042 utf8proc_uint8_t dst[8];
3043 size_t sz = 0;
3044
3045 if (IsPairTerm(t)) {
3046 while (t != TermNil) {
3047 int c;
3048
3049 Term hd = HeadOfTerm(t);
3050 if (IsAtomTerm(hd)) {
3051 Atom at = AtomOfTerm(hd);
3052 unsigned char *s = RepAtom(at)->UStrOfAE;
3053 int32_t ch;
3054 get_utf8(s, 1, &ch);
3055 c = ch;
3056 } else if (IsIntegerTerm(hd)) {
3057 c = IntegerOfTerm(hd);
3058 } else {
3059 c = '\0';
3060 }
3061
3062 sz += utf8proc_encode_char(c, dst);
3063 t = TailOfTerm(t);
3064 }
3065 } else if (IsAtomTerm(t)) {
3066 Atom at = AtomOfTerm(t);
3067 char *s = RepAtom(at)->StrOfAE;
3068 sz = strlen(s);
3069 } else if (IsStringTerm(t)) {
3070 sz = strlen(StringOfTerm(t));
3071 }
3072 return sz;
3073}
3074
3075X_API Int YAP_ListLength(Term t) {
3076 Term *aux;
3077
3078 Int n = Yap_SkipList(&t, &aux);
3079 if (IsVarTerm(*aux))
3080 return -1;
3081 if (*aux == TermNil)
3082 return n;
3083 return -1;
3084}
3085
3086X_API Int YAP_NumberVars(Term t, Int nbv) {
3087 return Yap_NumberVars(t, nbv, true);
3088}
3089
3090X_API Term YAP_UnNumberVars(Term t) {
3091 /* don't allow sharing of ground terms */
3092 return Yap_UnNumberTerm(t, NULL);
3093}
3094
3095X_API int YAP_IsNumberedVariable(Term t) {
3096 return IsApplTerm(t) && FunctorOfTerm(t) == FunctorDollarVar &&
3097 IsIntegerTerm(ArgOfTerm(1, t));
3098}
3099
3100 X_API size_t YAP_ExportTerm(Term inp, char *buf, size_t len) {
3101 if (!len)
3102 return 0;
3103 return Yap_ExportTerm(inp, buf, len, current_arity());
3104}
3105
3106X_API Term YAP_ImportTerm(char *buf) {
3107 return Yap_ImportTerm(buf);
3108}
3109
3110X_API size_t YAP_SizeOfExportedTerm(char *buf) {
3111 if (!buf)
3112 return 0;
3113 return Yap_SizeOfExportedTerm(buf);
3114}
3115
3116X_API Term YAP_ImportTfunnumberm(char *buf) { return Yap_ImportTerm(buf); }
3117
3118X_API int YAP_RequiresExtraStack(size_t sz) {
3119 CACHE_REGS
3120
3121 if (sz < 16 * 1024)
3122 sz = 16 * 1024;
3123 if (HR <= ASP - sz) {
3124 return FALSE;
3125 }
3126 BACKUP_H();
3127 while (HR > ASP - sz) {
3128 CACHE_REGS
3129 RECOVER_H();
3130 if (!Yap_dogc( PASS_REGS1)) {
3131 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, "needed %ld cells", sz);
3132 return -1;
3133 }
3134 BACKUP_H();
3135 }
3136 RECOVER_H();
3137 return TRUE;
3138}
3139
3140atom_t *TR_Atoms;
3141functor_t *TR_Functors;
3142size_t AtomTranslations, MaxAtomTranslations;
3143size_t FunctorTranslations, MaxFunctorTranslations;
3144
3145X_API Int YAP_AtomToInt(YAP_Atom At) {
3146 TranslationEntry *te = Yap_GetTranslationProp(At, 0);
3147 if (te != NIL)
3148 return te->Translation;
3149 TR_Atoms[AtomTranslations] = At;
3150 Yap_PutAtomTranslation(At, 0, AtomTranslations);
3151 AtomTranslations++;
3152 if (AtomTranslations == MaxAtomTranslations) {
3153 atom_t *ot = TR_Atoms;
3154 atom_t *nt = (atom_t *)malloc(sizeof(atom_t) * 2 * MaxAtomTranslations);
3155 if (nt == NULL) {
3156 Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
3157 "No more room for translations");
3158 return -1;
3159 }
3160 memmove(nt, ot, sizeof(atom_t) * MaxAtomTranslations);
3161 TR_Atoms = nt;
3162 free(ot);
3163 MaxAtomTranslations *= 2;
3164 }
3165 return AtomTranslations - 1;
3166}
3167
3168X_API YAP_Atom YAP_IntToAtom(Int i) { return TR_Atoms[i]; }
3169
3170X_API Int YAP_FunctorToInt(YAP_Functor f) {
3171 YAP_Atom At = NameOfFunctor(f);
3172 arity_t arity = ArityOfFunctor(f);
3173 TranslationEntry *te = Yap_GetTranslationProp(At, arity);
3174 if (te != NIL)
3175 return te->Translation;
3176 TR_Functors[FunctorTranslations] = f;
3177 Yap_PutAtomTranslation(At, arity, FunctorTranslations);
3178 FunctorTranslations++;
3179 if (FunctorTranslations == MaxFunctorTranslations) {
3180 functor_t *nt = (functor_t *)malloc(sizeof(functor_t) * 2 *
3181 MaxFunctorTranslations),
3182 *ot = TR_Functors;
3183 if (nt == NULL) {
3184 Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
3185 "No more room for translations");
3186 return -1;
3187 }
3188 memmove(nt, ot, sizeof(functor_t) * MaxFunctorTranslations);
3189 TR_Functors = nt;
3190 free(ot);
3191 MaxFunctorTranslations *= 2;
3192 }
3193 return FunctorTranslations - 1;
3194}
3195
3196X_API void *YAP_foreign_stream(int sno) {
3197 return GLOBAL_Stream[sno].u.private_data;
3198}
3199
3200X_API YAP_Functor YAP_IntToFunctor(Int i) { return TR_Functors[i]; }
3201
3202X_API YAP_PredEntryPtr YAP_TopGoal(void) {
3203 Functor f = Yap_MkFunctor(Yap_LookupAtom("yap_query"), 3);
3204 Term tmod = MkAtomTerm(Yap_LookupAtom("yapi"));
3205 PredEntry *p = RepPredProp(Yap_GetPredPropByFunc(f, tmod));
3206 return p;
3207}
3208
3209void yap_init(void) {}
3210
3211#endif // C_INTERFACE_C
3212
Main definitions.
const char * Yap_AbsoluteFile(const char *spec, bool ok)
generate absolute path, if ok first expand SICStus Prolog style
Definition: absf.c:145
X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, YAP_Term)
read a Prolog clause from a Prolog opened stream $s$
bool Yap_ResetException(yap_error_descriptor_t *i)
clean up (notice that the code ensures ActiveError exists on exit
Definition: errors.c:1425
bool Yap_RaiseException()
let's go
Definition: errors.c:1410
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
void Yap_ThrowError__(const char *file, const char *function, int lineno, yap_error_number type, Term where, const char *msg,...)
Throw an error directly to the error handler.
Definition: errors.c:789
int Yap_NumberVars(Term t, int numbv, bool handle_singles USES_REGS)
numbervariables in term t
Definition: terms.c:770
X_API void * YAP_GetStreamFromId(int no)
given a stream descriptor or stream alias (see open/3 ), return YAP's internal handle
Definition: c_interface.c:2172
X_API Term YAP_ReadFromStream(int sno)
read a Prolog term from a Prolog opened stream $s$
Definition: c_interface.c:2217
X_API Term YAP_Read(FILE *f)
read a Prolog term from an operating system stream $s$
Definition: c_interface.c:2206
X_API YAP_handle_t YAP_ArgsToSlots(int HowMany)
copies the first new n YAAM registers to slots
Definition: c_interface.c:2850
X_API YAP_Term * YAP_AddressFromSlot(YAP_handle_t)
get the memory address of a slot
Definition: c_interface.c:850
X_API size_t YAP_UTF8_TextLength(Term t)
Output the number of bytes needed to represent a string in UTF-8 Note that the terminating zero is no...
Definition: c_interface.c:3041
X_API void YAP_StartSlots(void)
initialize the slot data-structure: all existing slots will be discarded
Definition: c_interface.c:144
X_API void YAP_PutInSlot(YAP_handle_t slot, YAP_Term t)
store term in a slot
X_API void YAP_EndSlots(void)
discard all existing slots: operates as
Definition: c_interface.c:151
X_API YAP_Term * YAP_AddressOfTermInSlot(YAP_handle_t)
get the memory address of the term actually stored in a slot
Definition: c_interface.c:855
X_API yhandle_t YAP_CurrentSlot(void)
report the current position of the slots, assuming that they occupy the top of the stack
Definition: c_interface.c:825
X_API char * YAP_WriteDynamicBuffer(YAP_Term t, encoding_t enc, int flags)
write a a term to n user-provided buffer: make sure not tp overflow the buffer even if the text is mu...
Definition: c_interface.c:2305
X_API YAP_Term YAP_GetFromSlot(YAP_handle_t slot)
read from a slot
Definition: c_interface.c:845
X_API void * YAP_RepStreamFromId(int sno)
Obtain a pointer to the YAP representation of a stream.
Definition: c_interface.c:2387
X_API int YAP_RecoverSlots(int, YAP_handle_t topSlot)
Succeeds if it recovers the space allocated for $n$ contiguous slots starting at topSlot.
Definition: c_interface.c:840
X_API void YAP_SlotsToArgs(int HowMany, YAP_handle_t slot)
copies n slots such that sl is copied to the last abstract ,achine register
X_API char * YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
copy a string to a buffer, the buffer must have been malloced
Definition: c_interface.c:1362
X_API yhandle_t YAP_InitSlot(YAP_Term t)
allocate n empty new slots
Term Yap_read_term(int sno, Term opts, bool clause)
generic routine to read terms from a stream
Definition: readterm.c:1324
Definition: Yatom.h:689
opaque variables can interact with the system
Definition: YapDefs.h:229
Attributed variales are controlled by the attvar_record.
Definition: attvar.h:49
Definition: heapgc.h:272
A matrix.
Definition: matrix.c:68
Definition: Yatom.h:295
Definition: Yatom.h:544
Definition: Yatom.h:954
Definition: amidefs.h:264