YAP 7.1.0
stdpreds.c
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
8* *
9**************************************************************************
10* *
11* File: stdpreds.c *
12* comments: General-purpose C implemented system predicates *
13* *
14* Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $
15* *
16* *
17*************************************************************************/
18#ifdef SCCS
19static char SccsId[] = "%W% %G%";
20#endif
21
22#define HAS_CACHE_REGS 1
23/*
24* This file includes the definition of a miscellania of standard predicates
25* for yap refering to: Consulting, Executing a C predicate from call,
26* Comparisons (both general and numeric), Structure manipulation, Direct
27* access to atoms and predicates, Basic support for the debugger
28*
29* It also includes a table where all C-predicates are initializated
30*
31*/
32
33#include "Yap.h"
34#if YAP_JIT
35#include "amijit.h"
36#endif
37#include "Foreign.h"
38#include "YapHeap.h"
39#include "Yatom.h"
40#include "YapEval.h"
41#include "yapio.h"
42#ifdef TABLING
43#include "tab.macros.h"
44#endif /* TABLING */
45#if HAVE_UNISTD_H
46#include <unistd.h>
47#endif
48#include <stdio.h>
49#if HAVE_STRING_H
50#include <string.h>
51#endif
52#if HAVE_MALLOC_H
53#include <malloc.h>
54#endif
55#if YAP_JIT
56#include <JIT_Compiler.hpp>
57#endif
58#include <fcntl.h>
59#include <wchar.h>
60
61extern int init_tries(void);
62
63
64static Int p_setval(USES_REGS1);
65static Int p_value(USES_REGS1);
66static Int p_values(USES_REGS1);
67#ifdef undefined
68static CODEADDR *FindAtom(CODEADDR, int *);
69#endif /* undefined */
70static Int p_opdec(USES_REGS1);
71static Int p_univ(USES_REGS1);
72static Int p_abort(USES_REGS1);
73#ifdef BEAM
74Int p_halt(USES_REGS1);
75#else
76static Int p_halt(USES_REGS1);
77#endif
78static Int current_predicate(USES_REGS1);
79static Int cont_current_predicate(USES_REGS1);
80static OpEntry *NextOp(Prop CACHE_TYPE);
81static Int init_current_op(USES_REGS1);
82static Int cont_current_op(USES_REGS1);
83static Int init_current_atom_op(USES_REGS1);
84static Int cont_current_atom_op(USES_REGS1);
85static Int TrailMax(void);
86static Int GlobalMax(void);
87static Int LocalMax(void);
88static Int p_statistics_heap_max(USES_REGS1);
89static Int p_statistics_global_max(USES_REGS1);
90static Int p_statistics_local_max(USES_REGS1);
91static Int p_statistics_heap_info(USES_REGS1);
92static Int p_statistics_stacks_info(USES_REGS1);
93static Int p_statistics_trail_info(USES_REGS1);
94static Int p_cputime(USES_REGS1);
95static Int p_systime(USES_REGS1);
96static Int p_runtime(USES_REGS1);
97static Int p_walltime(USES_REGS1);
98static Int p_break(USES_REGS1);
99
100#if YAP_JIT
101void *(*Yap_JitCall)(JIT_Compiler *jc, yamop *p);
102void (*Yap_llvmShutdown)(void);
103Int (*Yap_traced_absmi)(void);
104
105static Int p_jit(USES_REGS1) { /* '$set_value'(+Atom,+Atomic) */
106 void *jit_handle;
107
108 if ((jit_handle = Yap_LoadForeignFile(YAP_YAPJITLIB, 0))) {
109 if (!Yap_CallForeignFile(jit_handle, "init_jit"))
110 fprintf(stderr, "Could not load JIT\n");
111 return FALSE;
112 }
113 return TRUE;
114}
115
116#endif /* YAP_JIT */
117
118#ifdef BEAM
119Int use_eam(USES_REGS1);
120Int eager_split(USES_REGS1);
121Int force_wait(USES_REGS1);
122Int commit(USES_REGS1);
123Int skip_while_var(USES_REGS1);
124Int wait_while_var(USES_REGS1);
125Int show_time(USES_REGS1);
126Int start_eam(USES_REGS1);
127Int cont_eam(USES_REGS1);
128
129extern int EAM;
130extern int eam_am(PredEntry *);
131extern int showTime(void);
132
133Int start_eam(USES_REGS1) {
134 if (eam_am((PredEntry *)0x1))
135 return (TRUE);
136 else {
137 cut_fail();
138 return (FALSE);
139 }
140}
141
142Int cont_eam(USES_REGS1) {
143 if (eam_am((PredEntry *)0x2))
144 return (TRUE);
145 else {
146 cut_fail();
147 return (FALSE);
148 }
149}
150
151Int use_eam(USES_REGS1) {
152 if (EAM)
153 EAM = 0;
154 else {
155 Yap_PutValue(AtomCArith, 0);
156 EAM = 1;
157 }
158 return (TRUE);
159}
160
161Int commit(USES_REGS1) {
162 if (EAM) {
163 printf("Nao deveria ter sido chamado commit do stdpreds\n");
164 exit(1);
165 }
166 return (TRUE);
167}
168
169Int skip_while_var(USES_REGS1) {
170 if (EAM) {
171 printf("Nao deveria ter sido chamado skip_while_var do stdpreds\n");
172 exit(1);
173 }
174 return (TRUE);
175}
176
177Int wait_while_var(USES_REGS1) {
178 if (EAM) {
179 printf("Nao deveria ter sido chamado wait_while_var do stdpreds\n");
180 exit(1);
181 }
182 return (TRUE);
183}
184
185Int force_wait(USES_REGS1) {
186 if (EAM) {
187 printf("Nao deveria ter sido chamado force_wait do stdpreds\n");
188 exit(1);
189 }
190 return (TRUE);
191}
192
193Int eager_split(USES_REGS1) {
194 if (EAM) {
195 printf("Nao deveria ter sido chamado eager_split do stdpreds\n");
196 exit(1);
197 }
198 return (TRUE);
199}
200
201Int show_time(USES_REGS1) /* MORE PRECISION */
202{
203 return (showTime());
204}
205
206#endif /* BEAM */
207
234static Int p_setval(USES_REGS1) { /* '$set_value'(+Atom,+Atomic) */
235 Term t1 = Deref(ARG1), t2 = Deref(ARG2);
236 if (!IsVarTerm(t1) && IsAtomTerm(t1) &&
237 (!IsVarTerm(t2) && (IsAtomTerm(t2) || IsNumTerm(t2)))) {
238 Yap_PutValue(AtomOfTerm(t1), t2);
239 return (TRUE);
240 }
241 return (FALSE);
242}
243
251static Int p_value(USES_REGS1) { /* '$get_value'(+Atom,?Val) */
252 Term t1 = Deref(ARG1);
253 if (IsVarTerm(t1)) {
254 Yap_ThrowError(INSTANTIATION_ERROR, t1, "get_value/2");
255 return (FALSE);
256 }
257 if (!IsAtomTerm(t1)) {
258 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "get_value/2");
259 return (FALSE);
260 }
261 return (Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1))));
262}
263
264static Int p_values(USES_REGS1) { /* '$values'(Atom,Old,New) */
265 Term t1 = Deref(ARG1), t3 = Deref(ARG3);
266
267 if (IsVarTerm(t1)) {
268 Yap_ThrowError(INSTANTIATION_ERROR, t1, "set_value/2");
269 return (FALSE);
270 }
271 if (!IsAtomTerm(t1)) {
272 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "set_value/2");
273 return (FALSE);
274 }
275 if (!Yap_unify_constant(ARG2, Yap_GetValue(AtomOfTerm(t1)))) {
276 return (FALSE);
277 }
278 if (!IsVarTerm(t3)) {
279 if (IsAtomTerm(t3) || IsNumTerm(t3)) {
280 Yap_PutValue(AtomOfTerm(t1), t3);
281 } else
282 return (FALSE);
283 }
284 return (TRUE);
285}
286
288
289static Int p_opdec(USES_REGS1) { /* '$opdec'(p,type,atom) */
290 /* we know the arguments are integer, atom, atom */
291 Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
292 Term tmod = Deref(ARG4);
293 if (tmod == TermProlog) {
294 tmod = PROLOG_MODULE;
295 }
296 return Yap_OpDec((int)IntOfTerm(p), (char *)RepAtom(AtomOfTerm(t))->StrOfAE,
297 AtomOfTerm(at), tmod);
298}
299
300#ifdef NO_STRTOD
301
302#if HAVE_CTYPE_H
303#include <ctype.h>
304#endif
305
306double strtod(s, pe) char *s, **pe;
307{
308 double r = atof(s);
309 *pe = s;
310 while (*s == ' ') {
311 ++s;
312 }
313 if (*s == '+' || *s == '-') {
314 ++s;
315 }
316 if (!isdigit(*s)) {
317 return (r);
318 }
319 while (isdigit(*s)) {
320 ++s;
321 }
322 if (*s == '.') {
323 ++s;
324 }
325 while (isdigit(*s)) {
326 ++s;
327 }
328 if (*s == 'e' || *s == 'E') {
329 ++s;
330 }
331 if (*s == '+' || *s == '-') {
332 ++s;
333 }
334 while (isdigit(*s)) {
335 ++s;
336 }
337 *pe = s;
338 return (r);
339}
340
341#else
342
343#include <stdlib.h>
344
345#endif
346
347#ifndef INFINITY
348#define INFINITY (1.0 / 0.0)
349#endif
350
351static UInt runtime(USES_REGS1) {
352 return (Yap_cputime() - Yap_total_gc_time() - Yap_total_stack_shift_time());
353}
354
355/* $runtime(-SinceInterval,-SinceStart) */
356static Int p_runtime(USES_REGS1) {
357 Int now, interval, gc_time, ss_time;
358 Term tnow, tinterval;
359
360 Yap_cputime_interval(&now, &interval);
361 gc_time = Yap_total_gc_time();
362 now -= gc_time;
363 ss_time = Yap_total_stack_shift_time();
364 now -= ss_time;
365 interval -= (gc_time - LOCAL_LastGcTime) + (ss_time - LOCAL_LastSSTime);
366 LOCAL_LastGcTime = gc_time;
367 LOCAL_LastSSTime = ss_time;
368 tnow = MkIntegerTerm(now);
369 tinterval = MkIntegerTerm(interval);
370 return (Yap_unify_constant(ARG1, tnow) &&
371 Yap_unify_constant(ARG2, tinterval));
372}
373
374/* $cputime(-SinceInterval,-SinceStart) */
375static Int p_cputime(USES_REGS1) {
376 Int now, interval;
377 Yap_cputime_interval(&now, &interval);
378 return (Yap_unify_constant(ARG1, MkIntegerTerm(now)) &&
379 Yap_unify_constant(ARG2, MkIntegerTerm(interval)));
380}
381
382static Int p_systime(USES_REGS1) {
383 Int now, interval;
384 Yap_systime_interval(&now, &interval);
385 return (Yap_unify_constant(ARG1, MkIntegerTerm(now)) &&
386 Yap_unify_constant(ARG2, MkIntegerTerm(interval)));
387}
388
389static Int p_walltime(USES_REGS1) {
390 uint64_t now, interval;
391 uint64_t t = Yap_walltime();
392 now = t - Yap_StartOfWTimes;
393 interval = t - LOCAL_LastWTime;
394 return (Yap_unify_constant(ARG1, MkIntegerTerm(now / 1000)) &&
395 Yap_unify_constant(ARG2, MkIntegerTerm(interval / 1000)));
396}
397
398static Int p_univ(USES_REGS1) { /* A =.. L */
399 unsigned int arity;
400 register Term tin;
401 Term twork, t2;
402 Atom at;
403
404 tin = Deref(ARG1);
405 t2 = Deref(ARG2);
406 if (IsVarTerm(tin)) {
407 /* we need to have a list */
408 Term *Ar;
409 if (IsVarTerm(t2)) {
410 Yap_ThrowError(INSTANTIATION_ERROR, t2, "(=..)/2");
411 return (FALSE);
412 }
413 if (!IsPairTerm(t2)) {
414 if (t2 == TermNil)
415 Yap_ThrowError(DOMAIN_ERROR_NON_EMPTY_LIST, t2, "(=..)/2");
416 else
417 Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "(=..)/2");
418 return (FALSE);
419 }
420 twork = HeadOfTerm(t2);
421 if (IsVarTerm(twork)) {
422 Yap_ThrowError(INSTANTIATION_ERROR, twork, "(=..)/2");
423 return (FALSE);
424 }
425 if (IsNumTerm(twork)) {
426 Term tt = TailOfTerm(t2);
427 if (IsVarTerm(tt)) {
428 Yap_ThrowError(INSTANTIATION_ERROR, tt, "(=..)/2");
429 return (FALSE);
430 }
431 if (tt != MkAtomTerm(AtomNil)) {
432 Yap_ThrowError(TYPE_ERROR_ATOMIC, twork, "(=..)/2");
433 return (FALSE);
434 }
435 return (Yap_unify_constant(ARG1, twork));
436 }
437 if (!IsAtomTerm(twork)) {
438 Term tt = TailOfTerm(t2);
439 if (IsVarTerm(tt)) {
440 Yap_ThrowError(INSTANTIATION_ERROR, twork, "(=..)/2");
441 return (FALSE);
442 } else if (tt == MkAtomTerm(AtomNil)) {
443 Yap_ThrowError(TYPE_ERROR_ATOMIC, twork, "(=..)/2");
444 return (FALSE);
445 } else {
446 Yap_ThrowError(TYPE_ERROR_ATOM, twork, "(=..)/2");
447 return (FALSE);
448 }
449 }
450 at = AtomOfTerm(twork);
451 twork = TailOfTerm(t2);
452 if (IsVarTerm(twork)) {
453 Yap_ThrowError(INSTANTIATION_ERROR, twork, "(=..)/2");
454 return (FALSE);
455 } else if (!IsPairTerm(twork)) {
456 if (twork != TermNil) {
457 Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "(=..)/2");
458 return (FALSE);
459 }
460 return (Yap_unify_constant(ARG1, MkAtomTerm(at)));
461 }
462 build_compound:
463 /* build the term directly on the heap */
464 Ar = HR;
465 HR++;
466
467 while (!IsVarTerm(twork) && IsPairTerm(twork)) {
468 *HR++ = HeadOfTerm(twork);
469 if (HR > ASP - 1024) {
470 /* restore space */
471 HR = Ar;
472 if (!Yap_dogc(PASS_REGS1)) {
473 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
474 return FALSE;
475 }
476 twork = TailOfTerm(Deref(ARG2));
477 goto build_compound;
478 }
479 twork = TailOfTerm(twork);
480 }
481 if (IsVarTerm(twork)) {
482 Yap_ThrowError(INSTANTIATION_ERROR, twork, "(=..)/2");
483 return (FALSE);
484 }
485 if (twork != TermNil) {
486 Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "(=..)/2");
487 return (FALSE);
488 }
489#ifdef SFUNC
490 DOES_NOT_WORK();
491 {
492 SFEntry *pe = (SFEntry *)Yap_GetAProp(at, SFProperty);
493 if (pe)
494 twork = MkSFTerm(Yap_MkFunctor(at, SFArity), arity, CellPtr(TR),
495 pe->NilValue);
496 else
497 twork = Yap_MkApplTerm(Yap_MkFunctor(at, arity), arity, CellPtr(TR));
498 }
499#else
500 arity = HR - Ar - 1;
501 if (at == AtomDot && arity == 2) {
502 Ar[0] = Ar[1];
503 Ar[1] = Ar[2];
504 HR--;
505 twork = AbsPair(Ar);
506 } else {
507 *Ar = (CELL)(Yap_MkFunctor(at, arity));
508 twork = AbsAppl(Ar);
509 }
510#endif
511 return (Yap_unify(ARG1, twork));
512 }
513 if (IsAtomicTerm(tin)) {
514 twork = MkPairTerm(tin, MkAtomTerm(AtomNil));
515 return (Yap_unify(twork, ARG2));
516 }
517 if (IsRefTerm(tin))
518 return (FALSE);
519 if (IsApplTerm(tin)) {
520 Functor fun = FunctorOfTerm(tin);
521 if (IsExtensionFunctor(fun)) {
522 twork = MkPairTerm(tin, MkAtomTerm(AtomNil));
523 return (Yap_unify(twork, ARG2));
524 }
525 arity = ArityOfFunctor(fun);
526 at = NameOfFunctor(fun);
527#ifdef SFUNC
528 if (arity == SFArity) {
529 CELL *p = CellPtr(TR);
530 CELL *q = ArgsOfSFTerm(tin);
531 int argno = 1;
532 while (*q) {
533 while (*q > argno++)
534 *p++ = MkVarTerm();
535 ++q;
536 *p++ = Deref(*q++);
537 }
538 twork = Yap_ArrayToList(CellPtr(TR), argno - 1);
539 while (IsIntTerm(twork)) {
540 if (!Yap_gc(2, ENV, gc_P(P, CP))) {
541 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
542 return (FALSE);
543 }
544 twork = Yap_ArrayToList(CellPtr(TR), argno - 1);
545 }
546 } else
547#endif
548 {
549 while (HR + arity * 2 > ASP - 1024) {
550 if (!Yap_dogc(PASS_REGS1)) {
551 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
552 return (FALSE);
553 }
554 tin = Deref(ARG1);
555 }
556 twork = Yap_ArrayToList(RepAppl(tin) + 1, arity);
557 }
558 } else {
559 /* We found a list */
560 at = AtomDot;
561 twork = Yap_ArrayToList(RepPair(tin), 2);
562 }
563 twork = MkPairTerm(MkAtomTerm(at), twork);
564 return (Yap_unify(ARG2, twork));
565}
566
567static Int p_abort(USES_REGS1) { /* abort */
568 /* make sure we won't go creeping around */
569 Yap_ThrowError(ABORT_EVENT, TermNil, "");
570 return (FALSE);
571}
572
573#ifdef BEAM
574extern void exit_eam(char *s);
575
576Int
577#else
578static Int
579#endif
580 p_halt(USES_REGS1) { /* halt */
581 Term t = Deref(ARG1);
582 Int out;
583
584#ifdef BEAM
585 if (EAM)
586 exit_eam("\n\n[ Prolog execution halted ]\n");
587#endif
588
589 if (IsVarTerm(t)) {
590 Yap_ThrowError(INSTANTIATION_ERROR, t, "halt/1");
591 return (FALSE);
592 }
593 if (!IsIntegerTerm(t)) {
594 Yap_ThrowError(TYPE_ERROR_INTEGER, t, "halt/1");
595 return (FALSE);
596 }
597 out = IntegerOfTerm(t);
598#if YAP_JIT
599 if (ExpEnv.analysis_struc.stats_enabled ||
600 ExpEnv.analysis_struc.time_pass_enabled) {
601 if (strcmp(((char *)ExpEnv.analysis_struc.outfile), "STDERR")) {
602 int stderrcopy = dup(2);
603 if (strcmp(((char *)ExpEnv.analysis_struc.outfile), "STDOUT") == 0) {
604 dup2(1, 2);
605#pragma GCC diagnostic push
606#pragma GCC diagnostic ignored "-Wimplicit-function-declaration"
607 shutdown_llvm();
608#pragma GCC diagnostic pop
609 dup2(stderrcopy, 2);
610 } else {
611 int Outputfile = open(((char *)ExpEnv.analysis_struc.outfile),
612 O_CREAT | O_APPEND | O_WRONLY, 0777);
613 if (Outputfile < 0) {
614 fprintf(stderr,
615 "Error:: I can not write analysis passes's output on %s...\n",
616 ((char *)ExpEnv.analysis_struc.outfile));
617 fprintf(stderr, " %s...\n", strerror(errno));
618 errno = 0;
619 exit(1);
620 }
621 dup2(Outputfile, 2);
622 shutdown_llvm();
623 close(Outputfile);
624 dup2(stderrcopy, 2);
625 }
626 close(stderrcopy);
627 } else
628 shutdown_llvm();
629 }
630#endif
631
632 Yap_exit(out);
633 return TRUE;
634}
635
636static bool valid_prop(Prop p, Term task) {
637 PredEntry *pe = RepPredProp(p);
638 if ((pe->PredFlags & HiddenPredFlag) || (pe->OpcodeOfPred == UNDEF_OPCODE)) {
639 return false;
640 }
641 if (task == TermSystem || task == TermProlog) {
642 return pe->PredFlags & StandardPredFlag;
643 }
644 if (task == TermUser) {
645 return !(pe->PredFlags & StandardPredFlag);
646 }
647 if (IsVarTerm(task)) {
648 return true;
649 }
650 return false;
651}
652
653static PropEntry *followLinkedListOfProps(PropEntry *p, Term task) {
654 while (p) {
655 if (p->KindOfPE == PEProp && valid_prop(p, task)) {
656 // found our baby..
657 return p;
658 }
659 p = p->NextOfPE;
660 }
661 return NIL;
662}
663
664static PropEntry *getPredProp(PropEntry *p, Term task) {
665 if (p == NIL)
666 return NIL;
667 while (p != NIL) {
668 if (p->KindOfPE == PEProp && valid_prop(p, task)) {
669 return p;
670 } else if (p->KindOfPE == FunctorProperty) {
671 // first search remainder of functor list
672 Prop pf;
673 if ((pf = followLinkedListOfProps(RepFunctorProp(p)->PropsOfFE, task))) {
674 return pf;
675 }
676 }
677 p = p->NextOfPE;
678 }
679 return NIL;
680}
681
682static PropEntry *nextPredForAtom(PropEntry *p, Term task) {
683 PredEntry *pe;
684 if (p == NIL)
685 return NIL;
686 pe = RepPredProp(p);
687 if (pe->ArityOfPE == 0 ||
688 (pe->PredFlags & (NumberDBPredFlag | AtomDBPredFlag))) {
689 // if atom prop, search atom list
690 return followLinkedListOfProps(p->NextOfPE, task);
691 } else {
692 FunctorEntry *f = pe->FunctorOfPred;
693 // first search remainder of functor list
694 PropEntry *pf;
695 if ((pf = followLinkedListOfProps(p->NextOfPE, task))) {
696 return pf;
697 }
698
699 // if that fails, follow the functor
700 return getPredProp(f->NextOfPE, task);
701 }
702}
703
704static Prop initFunctorSearch(Term t3, Term t2, Term task) {
705 if (IsAtomTerm(t3)) {
706 Atom at = AtomOfTerm(t3);
707 // access the entry at key address.
708 return followLinkedListOfProps(RepAtom(at)->PropsOfAE, task);
709 } else if (IsIntTerm(t3)) {
710 if (IsNonVarTerm(t2) && t2 != IDB_MODULE) {
711 Yap_ThrowError(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
712 return NULL;
713 } else {
714 Prop p;
715 // access the entry at key address.
716 // a single property (this will be deterministic
717 p = AbsPredProp(Yap_FindLUIntKey(IntOfTerm(t3)));
718 if (valid_prop(p, task))
719 return p;
720 }
721 Yap_ThrowError(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
722 return NULL;
723 } else {
724 Functor f;
725 if (IsPairTerm(t3)) {
726 f = FunctorDot;
727 } else {
728 f = FunctorOfTerm(t3);
729 if (IsExtensionFunctor(f)) {
730 Yap_ThrowError(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
731 return NULL;
732 }
733 }
734 return followLinkedListOfProps(f->PropsOfFE, task);
735 }
736}
737
738static PredEntry *firstModulePred(PredEntry *npp, Term task) {
739 if (!npp)
740 return NULL;
741 do {
742 npp = npp->NextPredOfModule;
743 } while (npp && !valid_prop(AbsPredProp(npp), task));
744 return npp;
745}
746
747static PredEntry *firstModulesPred(PredEntry *npp, ModEntry *m, Term task) {
748 do {
749 while (npp && !valid_prop(AbsPredProp(npp), task))
750 npp = npp->NextPredOfModule;
751 if (npp)
752 return npp;
753 m = m->NextME;
754 if (m) {
755 npp = m->PredForME;
756 } else
757 return NULL;
758 } while (npp || m);
759 return npp;
760}
761
762static Int cont_current_predicate(USES_REGS1) {
763 UInt Arity;
764 Term name, task;
765 Term t1 = ARG1, t2 = Deref(ARG2), t3 = ARG3;
766 bool rc, will_cut = false;
767 Functor f;
768 PredEntry *pp;
769 t1 = Yap_YapStripModule(t1, &t2);
770 t3 = Yap_YapStripModule(t3, &t2);
771 t1 = Deref(t1);
772 t2 = Deref(t2);
773 task = Deref(ARG4);
774
775 pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
776 if (IsNonVarTerm(t3)) {
777 PropEntry *np, *p;
778
779 if (IsNonVarTerm(t2)) {
780 // module and functor known, should be easy
781 if (IsAtomTerm(t3)) {
782 if ((p = Yap_GetPredPropByAtom(AtomOfTerm(t3), t2)) &&
783 valid_prop(p, task)) {
784 cut_succeed();
785 } else {
786 cut_fail();
787 }
788 } else {
789 if ((p = Yap_GetPredPropByFunc(FunctorOfTerm(t3), t2)) &&
790 valid_prop(p, task)) {
791 cut_succeed();
792 } else {
793 cut_fail();
794 }
795 }
796 }
797
798 // t3 is a functor, or compound term,
799 // just follow the functor chain
800 p = AbsPredProp(pp);
801 if (!p) {
802 // initial search, tracks down what is the first call with
803 // that name, functor..
804 p = initFunctorSearch(t3, t2, task);
805 // now, we can do lookahead.
806 if (p == NIL)
807 cut_fail();
808 pp = RepPredProp(p);
809 }
810 np = followLinkedListOfProps(p->NextOfPE, task);
811 Term mod = pp->ModuleOfPred;
812 if (mod == PROLOG_MODULE)
813 mod = TermProlog;
814 bool b = Yap_unify(t2, mod);
815 if (!np) {
816 if (b)
817 cut_succeed();
818 else
819 cut_fail();
820 } else {
821 EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(RepPredProp(np));
822 B->cp_h = HR;
823 return b;
824 }
825 } else if (IsNonVarTerm(t1)) {
826 PropEntry *np, *p;
827 // run over the same atom any predicate defined for that atom
828 // may be fair bait, depends on whether we know the module.
829 p = AbsPredProp(pp);
830 if (!p) {
831 // initialization time
832 if (IsIntTerm(t1)) {
833 // or this or nothing....
834 p = AbsPredProp(Yap_FindLUIntKey(IntOfTerm(t3)));
835 } else if (IsAtomTerm(t1)) {
836 // should be the usual situation.
837 Atom at = AtomOfTerm(t1);
838 p = getPredProp(RepAtom(at)->PropsOfAE, task);
839 } else {
840 Yap_ThrowError(TYPE_ERROR_CALLABLE, t1, "current_predicate/2");
841 return false;
842 }
843 if (!p)
844 cut_fail();
845 pp = RepPredProp(p);
846 }
847 // now, we can do lookahead.
848 np = nextPredForAtom(p, task);
849 if (!np)
850 will_cut = true;
851 else {
852 EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(RepPredProp(np));
853 B->cp_h = HR;
854 }
855 } else if (IsNonVarTerm(t2)) {
856 // operating within the same module.
857 PredEntry *npp;
858
859 if (!pp) {
860 if (!IsAtomTerm(t2)) {
861 Yap_ThrowError(TYPE_ERROR_ATOM, t2, "module name");
862 }
863 ModEntry *m = Yap_GetModuleEntry(t2);
864 pp = m->PredForME;
865 while (pp && !valid_prop(AbsPredProp(pp), task)) {
866 pp = pp->NextPredOfModule;
867 }
868 if (!pp) {
869 /* try Prolog Module */
870 cut_fail();
871 }
872 }
873 npp = firstModulePred(pp, task);
874
875 if (!npp) {
876 will_cut = true;
877 }
878 // just try next one
879 else {
880 EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp);
881 B->cp_h = HR;
882 }
883 } else {
884 // operating across all modules.
885 PredEntry *npp = pp;
886 ModEntry *me;
887
888 if (!pp) {
889 pp = firstModulesPred(CurrentModules->PredForME, CurrentModules, task);
890 }
891 if (!pp)
892 cut_fail();
893 if (pp->ModuleOfPred == PROLOG_MODULE)
894 me = Yap_GetModuleEntry(TermProlog);
895 else
896 me = Yap_GetModuleEntry(pp->ModuleOfPred);
897 npp = firstModulesPred(pp->NextPredOfModule, me, task);
898 if (!npp)
899 will_cut = true;
900 // just try next module.
901 else {
902 EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp);
903 B->cp_h = HR;
904 }
905 }
906
907 if (pp->ModuleOfPred != IDB_MODULE) {
908 f = pp->FunctorOfPred;
909 Arity = pp->ArityOfPE;
910 if (Arity)
911 name = MkAtomTerm(NameOfFunctor(f));
912 else
913 name = MkAtomTerm((Atom)f);
914 } else {
915 if (pp->PredFlags & NumberDBPredFlag) {
916 name = MkIntegerTerm(pp->src.IndxId);
917 Arity = 0;
918 } else if (pp->PredFlags & AtomDBPredFlag) {
919 f = pp->FunctorOfPred;
920 name = MkAtomTerm((Atom)f);
921 Arity = 0;
922 } else {
923 f = pp->FunctorOfPred;
924 name = MkAtomTerm(NameOfFunctor(f));
925 Arity = ArityOfFunctor(pp->FunctorOfPred);
926 }
927 }
928 if (Arity) {
929 rc = Yap_unify(ARG3, Yap_MkNewApplTerm(f, Arity));
930 } else {
931 rc = Yap_unify(ARG3, name);
932 }
933 rc = rc && (IsAtomTerm(t2) || Yap_unify(ARG2, ModToTerm(pp->ModuleOfPred))) &&
934 Yap_unify(ARG1, name);
935 if (will_cut) {
936 if (rc)
937 cut_succeed();
938 cut_fail();
939 }
940 return rc;
941}
942
943static Int current_predicate(USES_REGS1) {
944 EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(NULL);
945 // ensure deref access to choice-point fields.
946 return cont_current_predicate(PASS_REGS1);
947}
948
949static OpEntry *NextOp(Prop pp USES_REGS) {
950
951 while (!EndOfPAEntr(pp) &&
952 pp->KindOfPE != OpProperty &&
953 (RepOpProp(pp)->OpModule != PROLOG_MODULE || RepOpProp(pp)->OpModule != CurrentModule)
954 )
955 pp = pp->NextOfPE;
956 return RepOpProp(pp);
957}
958
959int Yap_IsOp(Atom at) {
960 CACHE_REGS
961 OpEntry *op = NextOp(RepAtom(at)->PropsOfAE PASS_REGS);
962 return (!EndOfPAEntr(op));
963}
964
965int Yap_IsOpMaxPrio(Atom at) {
966 CACHE_REGS
967 OpEntry *op = NextOp(RepAtom(at)->PropsOfAE PASS_REGS);
968 int max;
969
970 if (EndOfPAEntr(op))
971 return 0;
972 max = (op->Prefix & 0xfff);
973 if ((op->Infix & 0xfff) > max)
974 max = op->Infix & 0xfff;
975 if ((op->Posfix & 0xfff) > max)
976 max = op->Posfix & 0xfff;
977 return max;
978}
979
980static Int unify_op(OpEntry *op USES_REGS) {
981 Term tmod = op->OpModule;
982
983 if (tmod == PROLOG_MODULE)
984 tmod = TermProlog;
985 return Yap_unify_constant(ARG2, tmod) &&
986 Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
987 Yap_unify_constant(ARG4, MkIntegerTerm(op->Infix)) &&
988 Yap_unify_constant(ARG5, MkIntegerTerm(op->Posfix));
989}
990
991static Int cont_current_op(USES_REGS1) {
992 OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next;
993
994 READ_LOCK(op->OpRWLock);
995 next = op->OpNext;
996 if (Yap_unify_constant(ARG1, MkAtomTerm(op->OpName)) &&
997 unify_op(op PASS_REGS)) {
998 READ_UNLOCK(op->OpRWLock);
999 if (next) {
1000 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
1001 B->cp_h = HR;
1002 return TRUE;
1003 } else {
1004 cut_succeed();
1005 }
1006 } else {
1007 READ_UNLOCK(op->OpRWLock);
1008 if (next) {
1009 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
1010 B->cp_h = HR;
1011 return FALSE;
1012 } else {
1013 cut_fail();
1014 }
1015 }
1016}
1017
1018static Int init_current_op(
1019 USES_REGS1) { /* current_op(-Precedence,-Type,-Atom) */
1020 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)OpList);
1021 B->cp_h = HR;
1022 return cont_current_op(PASS_REGS1);
1023}
1024
1025static Int cont_current_atom_op(USES_REGS1) {
1026 OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next;
1027
1028 READ_LOCK(op->OpRWLock);
1029 next = NextOp(op->NextOfPE PASS_REGS);
1030 if (unify_op(op PASS_REGS)) {
1031 READ_UNLOCK(op->OpRWLock);
1032 if (next) {
1033 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
1034 B->cp_h = HR;
1035 return TRUE;
1036 } else {
1037 cut_succeed();
1038 }
1039 } else {
1040 READ_UNLOCK(op->OpRWLock);
1041 if (next) {
1042 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
1043 B->cp_h = HR;
1044 return FALSE;
1045 } else {
1046 cut_fail();
1047 }
1048 }
1049}
1050
1051static Int init_current_atom_op(
1052 USES_REGS1) { /* current_op(-Precedence,-Type,-Atom) */
1053 Term t = Deref(ARG1);
1054 AtomEntry *ae;
1055 OpEntry *ope;
1056
1057 if (IsVarTerm(t) || !IsAtomTerm(t)) {
1058 Yap_ThrowError(TYPE_ERROR_ATOM, t, "current_op/3");
1059 cut_fail();
1060 }
1061 ae = RepAtom(AtomOfTerm(t));
1062 if (EndOfPAEntr((ope = NextOp(ae->PropsOfAE PASS_REGS)))) {
1063 cut_fail();
1064 }
1065 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((Int)ope);
1066 B->cp_h = HR;
1067 return cont_current_atom_op(PASS_REGS1);
1068}
1069
1070#if 0
1071static Int
1072 copy_local_ops(USES_REGS1) { /* current_op(-Precedence,-Type,-Atom) */
1073 Term tmodin = Deref(ARG1);
1074 Term t = Deref(ARG1);
1075 AtomEntry *ae;
1076 OpEntry *ope;
1077
1078 if (IsVarTerm(t) || !IsAtomTerm(t)) {
1079 Yap_ThrowError(TYPE_ERROR_ATOM, t, "current_op/3");
1080 cut_fail();
1081 }
1082 ae = RepAtom(AtomOfTerm(t));
1083 if (EndOfPAEntr((ope = NextOp(ae->PropsOfAE PASS_REGS)))) {
1084 cut_fail();
1085 }
1086 EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((Int)ope);
1087 B->cp_h = HR;
1088 return cont_current_atom_op(PASS_REGS1);
1089}
1090#endif
1091
1092void Yap_show_statistics(void) {
1093 CACHE_REGS
1094 unsigned long int heap_space_taken;
1095 double frag;
1096
1097#if USE_SYSTEM_MALLOC && HAVE_MALLINFO
1098 struct mallinfo mi = mallinfo();
1099
1100 heap_space_taken = (mi.arena + mi.hblkhd) - Yap_HoleSize;
1101#else
1102 heap_space_taken =
1103 (unsigned long int)(Unsigned(HeapTop) - Unsigned(Yap_HeapBase)) -
1104 Yap_HoleSize;
1105#endif
1106 frag = (100.0 * (heap_space_taken - HeapUsed)) / heap_space_taken;
1107
1108 fprintf(stderr, "Code Space: " UInt_FORMAT " (" UInt_FORMAT
1109 " bytes needed, " UInt_FORMAT " bytes used, "
1110 "fragmentation %.3f%%).\n",
1111 Unsigned(H0) - Unsigned(Yap_HeapBase),
1112 Unsigned(HeapTop) - Unsigned(Yap_HeapBase), Unsigned(HeapUsed), frag);
1113 fprintf(stderr, "Stack Space: " UInt_FORMAT " (" UInt_FORMAT
1114 " for Global, " UInt_FORMAT " for local).\n",
1115 Unsigned(sizeof(CELL) * (LCL0 - H0)),
1116 Unsigned(sizeof(CELL) * (HR - H0)),
1117 Unsigned(sizeof(CELL) * (LCL0 - ASP)));
1118 fprintf(
1119 stderr, "Trail Space: " UInt_FORMAT " (" UInt_FORMAT " used).\n",
1120 Unsigned(sizeof(tr_fr_ptr) *
1121 (Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase))),
1122 Unsigned(sizeof(tr_fr_ptr) * (Unsigned(TR) - Unsigned(LOCAL_TrailBase))));
1123 fprintf(stderr, "Runtime: " UInt_FORMAT "\n", runtime(PASS_REGS1));
1124 fprintf(stderr, "Cputime: " UInt_FORMAT "\n", Yap_cputime());
1125
1126 fprintf(stderr, "Walltime: %" PRIu64 ".\n", Yap_walltime() / (UInt)1000);
1127}
1128
1129static Int p_statistics_heap_max(USES_REGS1) {
1130 Term tmax = MkIntegerTerm(HeapMax);
1131
1132 return (Yap_unify(tmax, ARG1));
1133}
1134
1135/* The results of the next routines are not to be trusted too */
1136/* much. Basically, any stack shifting will seriously confuse the */
1137/* results */
1138
1139static Int TrailTide = -1, LocalTide = -1, GlobalTide = -1;
1140
1141/* maximum Trail usage */
1142static Int TrailMax(void) {
1143 CACHE_REGS
1144 Int i;
1145 Int TrWidth = Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase);
1146 CELL *pt;
1147
1148 if (TrailTide != TrWidth) {
1149 pt = (CELL *)TR;
1150 while (pt + 2 < (CELL *)LOCAL_TrailTop) {
1151 if (pt[0] == 0 && pt[1] == 0 && pt[2] == 0)
1152 break;
1153 else
1154 pt++;
1155 }
1156 if (pt + 2 < (CELL *)LOCAL_TrailTop)
1157 i = Unsigned(pt) - Unsigned(LOCAL_TrailBase);
1158 else
1159 i = TrWidth;
1160 } else
1161 return (TrWidth);
1162 if (TrailTide > i)
1163 i = TrailTide;
1164 else
1165 TrailTide = i;
1166 return (i);
1167}
1168
1169static Int p_statistics_trail_max(USES_REGS1) {
1170 Term tmax = MkIntegerTerm(TrailMax());
1171
1172 return (Yap_unify(tmax, ARG1));
1173}
1174
1175/* maximum Global usage */
1176static Int GlobalMax(void) {
1177 CACHE_REGS
1178 Int i;
1179 Int StkWidth = Unsigned(LCL0) - Unsigned(H0);
1180 CELL *pt;
1181
1182 if (GlobalTide != StkWidth) {
1183 pt = HR;
1184 while (pt + 2 < ASP) {
1185 if (pt[0] == 0 && pt[1] == 0 && pt[2] == 0)
1186 break;
1187 else
1188 pt++;
1189 }
1190 if (pt + 2 < ASP)
1191 i = Unsigned(pt) - Unsigned(H0);
1192 else
1193 /* so that both Local and Global have reached maximum width */
1194 GlobalTide = LocalTide = i = StkWidth;
1195 } else
1196 return (StkWidth);
1197 if (GlobalTide > i)
1198 i = GlobalTide;
1199 else
1200 GlobalTide = i;
1201 return (i);
1202}
1203
1204static Int p_statistics_global_max(USES_REGS1) {
1205 Term tmax = MkIntegerTerm(GlobalMax());
1206
1207 return (Yap_unify(tmax, ARG1));
1208}
1209
1210static Int LocalMax(void) {
1211 CACHE_REGS
1212 Int i;
1213 Int StkWidth = Unsigned(LCL0) - Unsigned(H0);
1214 CELL *pt;
1215
1216 if (LocalTide != StkWidth) {
1217 pt = LCL0;
1218 while (pt - 3 > HR) {
1219 if (pt[-1] == 0 && pt[-2] == 0 && pt[-3] == 0)
1220 break;
1221 else
1222 --pt;
1223 }
1224 if (pt - 3 > HR)
1225 i = Unsigned(LCL0) - Unsigned(pt);
1226 else
1227 /* so that both Local and Global have reached maximum width */
1228 GlobalTide = LocalTide = i = StkWidth;
1229 } else
1230 return (StkWidth);
1231 if (LocalTide > i)
1232 i = LocalTide;
1233 else
1234 LocalTide = i;
1235 return (i);
1236}
1237
1238static Int p_statistics_local_max(USES_REGS1) {
1239 Term tmax = MkIntegerTerm(LocalMax());
1240
1241 return (Yap_unify(tmax, ARG1));
1242}
1243
1244static Int p_statistics_heap_info(USES_REGS1) {
1245 Term tusage = MkIntegerTerm(HeapUsed);
1246
1247#if USE_SYSTEM_MALLOC && HAVE_MALLINFO
1248 struct mallinfo mi = mallinfo();
1249
1250 UInt sstack = Yap_HoleSize + (LOCAL_TrailTop - LOCAL_GlobalBase);
1251 UInt mmax = (mi.arena + mi.hblkhd);
1252 Term tmax = MkIntegerTerm(mmax - sstack);
1253 tusage = MkIntegerTerm(mmax - (mi.fordblks + sstack));
1254#else
1255 Term tmax = MkIntegerTerm((LOCAL_GlobalBase - Yap_HeapBase) - Yap_HoleSize);
1256#endif
1257
1258 return (Yap_unify(tmax, ARG1) && Yap_unify(tusage, ARG2));
1259}
1260
1261static Int p_statistics_stacks_info(USES_REGS1) {
1262 Term tmax = MkIntegerTerm(Unsigned(LCL0) - Unsigned(H0));
1263 Term tgusage = MkIntegerTerm(Unsigned(HR) - Unsigned(H0));
1264 Term tlusage = MkIntegerTerm(Unsigned(LCL0) - Unsigned(ASP));
1265
1266 return (Yap_unify(tmax, ARG1) && Yap_unify(tgusage, ARG2) &&
1267 Yap_unify(tlusage, ARG3));
1268}
1269
1270static Int p_statistics_trail_info(USES_REGS1) {
1271 Term tmax =
1272 MkIntegerTerm(Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase));
1273 Term tusage = MkIntegerTerm(Unsigned(TR) - Unsigned(LOCAL_TrailBase));
1274
1275 return (Yap_unify(tmax, ARG1) && Yap_unify(tusage, ARG2));
1276}
1277
1278static Int p_statistics_atom_info(USES_REGS1) {
1279 UInt count = 0, spaceused = 0, i;
1280
1281 for (i = 0; i < AtomHashTableSize; i++) {
1282 Atom catom;
1283
1284 READ_LOCK(HashChain[i].AERWLock);
1285 catom = HashChain[i].Entry;
1286 if (catom != NIL) {
1287 READ_LOCK(RepAtom(catom)->ARWLock);
1288 }
1289 READ_UNLOCK(HashChain[i].AERWLock);
1290 while (catom != NIL) {
1291 Atom ncatom;
1292 count++;
1293 spaceused +=
1294 sizeof(AtomEntry) + strlen((char *)RepAtom(catom)->StrOfAE) + 1;
1295 ncatom = RepAtom(catom)->NextOfAE;
1296 if (ncatom != NIL) {
1297 READ_LOCK(RepAtom(ncatom)->ARWLock);
1298 }
1299 READ_UNLOCK(RepAtom(catom)->ARWLock);
1300 catom = ncatom;
1301 }
1302 }
1303 for (i = 0; i < WideAtomHashTableSize; i++) {
1304 Atom catom;
1305
1306 READ_LOCK(WideHashChain[i].AERWLock);
1307 catom = WideHashChain[i].Entry;
1308 if (catom != NIL) {
1309 READ_LOCK(RepAtom(catom)->ARWLock);
1310 }
1311 READ_UNLOCK(WideHashChain[i].AERWLock);
1312 while (catom != NIL) {
1313 Atom ncatom;
1314 count++;
1315 spaceused +=
1316 sizeof(AtomEntry) +
1317 sizeof(wchar_t) * (wcslen((wchar_t *)(RepAtom(catom)->StrOfAE) + 1));
1318 ncatom = RepAtom(catom)->NextOfAE;
1319 if (ncatom != NIL) {
1320 READ_LOCK(RepAtom(ncatom)->ARWLock);
1321 }
1322 READ_UNLOCK(RepAtom(catom)->ARWLock);
1323 catom = ncatom;
1324 }
1325 }
1326 return Yap_unify(ARG1, MkIntegerTerm(count)) &&
1327 Yap_unify(ARG2, MkIntegerTerm(spaceused));
1328}
1329
1330static Int p_statistics_db_size(USES_REGS1) {
1331 Term t = MkIntegerTerm(Yap_ClauseSpace);
1332 Term tit = MkIntegerTerm(Yap_IndexSpace_Tree);
1333 Term tis = MkIntegerTerm(Yap_IndexSpace_SW);
1334 Term tie = MkIntegerTerm(Yap_IndexSpace_EXT);
1335
1336 return Yap_unify(t, ARG1) && Yap_unify(tit, ARG2) && Yap_unify(tis, ARG3) &&
1337 Yap_unify(tie, ARG4);
1338}
1339
1340static Int p_statistics_lu_db_size(USES_REGS1) {
1341 Term t = MkIntegerTerm(Yap_LUClauseSpace);
1342 Term tit = MkIntegerTerm(Yap_LUIndexSpace_Tree);
1343 Term tic = MkIntegerTerm(Yap_LUIndexSpace_CP);
1344 Term tix = MkIntegerTerm(Yap_LUIndexSpace_EXT);
1345 Term tis = MkIntegerTerm(Yap_LUIndexSpace_SW);
1346
1347 return Yap_unify(t, ARG1) && Yap_unify(tit, ARG2) && Yap_unify(tic, ARG3) &&
1348 Yap_unify(tis, ARG4) && Yap_unify(tix, ARG5);
1349}
1350
1351static Int p_executable(USES_REGS1) {
1352 int lvl = push_text_stack();
1353 const char *tmp =
1354
1355 Yap_AbsoluteFile(GLOBAL_argv[0], true);
1356 if (!tmp || tmp[0] == '\0' ) {
1357 tmp = Malloc(MAX_PATH + 1);
1358 strncpy((char *)tmp, Yap_FindExecutable(), MAX_PATH);
1359 }
1360 Atom at = Yap_LookupAtom(tmp);
1361 pop_text_stack(lvl);
1362 return Yap_unify(MkAtomTerm(at), ARG1);
1363}
1364
1365static Int p_system_mode(USES_REGS1) {
1366 Term t1 = Deref(ARG1);
1367
1368 if (IsVarTerm(t1)) {
1369 if (LOCAL_PrologMode & SystemMode)
1370 return Yap_unify(t1, MkAtomTerm(AtomTrue));
1371 else
1372 return Yap_unify(t1, MkAtomTerm(AtomFalse));
1373 } else {
1374 Atom at = AtomOfTerm(t1);
1375 if (at == AtomFalse)
1376 LOCAL_PrologMode &= ~SystemMode;
1377 else
1378 LOCAL_PrologMode |= SystemMode;
1379 }
1380 return TRUE;
1381}
1382
1383static Int p_lock_system(USES_REGS1) {
1384 LOCK(GLOBAL_BGL);
1385 return TRUE;
1386}
1387
1388static Int p_unlock_system(USES_REGS1) {
1389 UNLOCK(GLOBAL_BGL);
1390 return TRUE;
1391}
1392
1393static Int enter_undefp(USES_REGS1) {
1394 if (LOCAL_DoingUndefp) {
1395 return FALSE;
1396 }
1397 LOCAL_DoingUndefp = TRUE;
1398 return TRUE;
1399}
1400
1401static Int exit_undefp(USES_REGS1) {
1402 if (LOCAL_DoingUndefp) {
1403 LOCAL_DoingUndefp = FALSE;
1404 return TRUE;
1405 }
1406 return FALSE;
1407}
1408
1409#ifdef DEBUG
1410extern void DumpActiveGoals(void);
1411
1412static Int p_dump_active_goals(USES_REGS1) {
1413 DumpActiveGoals();
1414 return (TRUE);
1415}
1416#endif
1417
1418#ifdef INES
1419static Int p_euc_dist(USES_REGS1) {
1420 Term t1 = Deref(ARG1);
1421 Term t2 = Deref(ARG2);
1422 double d1 = (double)(IntegerOfTerm(ArgOfTerm(1, t1)) -
1423 IntegerOfTerm(ArgOfTerm(1, t2)));
1424 double d2 = (double)(IntegerOfTerm(ArgOfTerm(2, t1)) -
1425 IntegerOfTerm(ArgOfTerm(2, t2)));
1426 double d3 = (double)(IntegerOfTerm(ArgOfTerm(3, t1)) -
1427 IntegerOfTerm(ArgOfTerm(3, t2)));
1428 Int result = (Int)sqrt(d1 * d1 + d2 * d2 + d3 * d3);
1429 return (Yap_unify(ARG3, MkIntegerTerm(result)));
1430}
1431
1432volatile int loop_counter = 0;
1433
1434static Int p_loop(USES_REGS1) {
1435 while (loop_counter == 0)
1436 ;
1437 return (TRUE);
1438}
1439#endif
1440
1441static Int p_break(USES_REGS1) {
1442 Atom at = AtomOfTerm(Deref(ARG1));
1443 if (at == AtomTrue) {
1444 LOCAL_BreakLevel++;
1445 return TRUE;
1446 }
1447 if (at == AtomFalse) {
1448 LOCAL_BreakLevel--;
1449 return TRUE;
1450 }
1451 return FALSE;
1452}
1453
1454void Yap_InitBackCPreds(void) {
1455 Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate,
1456 cont_current_predicate, SafePredFlag | SyncPredFlag);
1457 Yap_InitCPredBack("$current_op", 5, 1, init_current_op, cont_current_op,
1458 SafePredFlag | SyncPredFlag);
1459 Yap_InitCPredBack("$current_atom_op", 5, 1, init_current_atom_op,
1460 cont_current_atom_op, SafePredFlag | SyncPredFlag);
1461#ifdef BEAM
1462 Yap_InitCPredBack("eam", 1, 0, start_eam, cont_eam, SafePredFlag);
1463#endif
1464
1465 Yap_InitBackAtoms();
1466 Yap_InitBackIO();
1467 Yap_InitBackDB();
1468 Yap_InitUserBacks();
1469}
1470
1471typedef void (*Proc)(void);
1472
1473Proc E_Modules[] = {/* init_fc,*/ (Proc)0};
1474
1475#ifdef YAPOR
1476static Int p_parallel_mode(USES_REGS1) { return FALSE; }
1477
1478static Int p_yapor_workers(USES_REGS1) { return FALSE; }
1479#endif /* YAPOR */
1480
1481void Yap_InitCPreds(void) {
1482 /* numerical comparison */
1483 Yap_InitCPred("set_value", 2, p_setval, SafePredFlag | SyncPredFlag);
1484 Yap_InitCPred("get_value", 2, p_value,
1485 TestPredFlag | SafePredFlag | SyncPredFlag);
1486 Yap_InitCPred("$values", 3, p_values, SafePredFlag | SyncPredFlag);
1487 /* general purpose */
1488 Yap_InitCPred("opdec", 4, p_opdec, SafePredFlag | SyncPredFlag);
1489 Yap_InitCPred("=..", 2, p_univ, 0);
1500 Yap_InitCPred("$statistics_trail_max", 1, p_statistics_trail_max,
1501 SafePredFlag | SyncPredFlag);
1502 Yap_InitCPred("$statistics_heap_max", 1, p_statistics_heap_max,
1503 SafePredFlag | SyncPredFlag);
1504 Yap_InitCPred("$statistics_global_max", 1, p_statistics_global_max,
1505 SafePredFlag | SyncPredFlag);
1506 Yap_InitCPred("$statistics_local_max", 1, p_statistics_local_max,
1507 SafePredFlag | SyncPredFlag);
1508 Yap_InitCPred("$statistics_heap_info", 2, p_statistics_heap_info,
1509 SafePredFlag | SyncPredFlag);
1510 Yap_InitCPred("$statistics_stacks_info", 3, p_statistics_stacks_info,
1511 SafePredFlag | SyncPredFlag);
1512 Yap_InitCPred("$statistics_trail_info", 2, p_statistics_trail_info,
1513 SafePredFlag | SyncPredFlag);
1514 Yap_InitCPred("$statistics_atom_info", 2, p_statistics_atom_info,
1515 SafePredFlag | SyncPredFlag);
1516 Yap_InitCPred("$statistics_db_size", 4, p_statistics_db_size,
1517 SafePredFlag | SyncPredFlag);
1518 Yap_InitCPred("$statistics_lu_db_size", 5, p_statistics_lu_db_size,
1519 SafePredFlag | SyncPredFlag);
1520 Yap_InitCPred("$executable", 1, p_executable, SafePredFlag);
1521 Yap_InitCPred("$runtime", 2, p_runtime, SafePredFlag | SyncPredFlag);
1522 Yap_InitCPred("$cputime", 2, p_cputime, SafePredFlag | SyncPredFlag);
1523 Yap_InitCPred("$systime", 2, p_systime, SafePredFlag | SyncPredFlag);
1524 Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag | SyncPredFlag);
1525 Yap_InitCPred("$system_mode", 1, p_system_mode, SafePredFlag | SyncPredFlag);
1526 Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
1537 Yap_InitCPred("$break", 1, p_break, SafePredFlag);
1538#ifdef BEAM
1539 Yap_InitCPred("@", 0, eager_split, SafePredFlag);
1540 Yap_InitCPred(":", 0, force_wait, SafePredFlag);
1541 Yap_InitCPred("/", 0, commit, SafePredFlag);
1542 Yap_InitCPred("skip_while_var", 1, skip_while_var, SafePredFlag);
1543 Yap_InitCPred("wait_while_var", 1, wait_while_var, SafePredFlag);
1544 Yap_InitCPred("eamtime", 0, show_time, SafePredFlag);
1545 Yap_InitCPred("eam", 0, use_eam, SafePredFlag);
1546#endif
1547 Yap_InitCPred("$halt", 1, p_halt, SyncPredFlag);
1548 Yap_InitCPred("$lock_system", 0, p_lock_system, SafePredFlag);
1549 Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag);
1550 Yap_InitCPred("$enter_undefp", 0, enter_undefp, SafePredFlag);
1551 Yap_InitCPred("$exit_undefp", 0, exit_undefp, SafePredFlag);
1552
1553#ifdef YAP_JIT
1554 Yap_InitCPred("$jit_init", 1, p_jit, SafePredFlag | SyncPredFlag);
1555#endif /* YAPOR */
1556#ifdef INES
1557 Yap_InitCPred("euc_dist", 3, p_euc_dist, SafePredFlag);
1558 Yap_InitCPred("loop", 0, p_loop, SafePredFlag);
1559#endif
1560#if QSAR
1561 Yap_InitCPred("in_range", 8, p_in_range, TestPredFlag | SafePredFlag);
1562 Yap_InitCPred("in_range", 4, p_in_range2, TestPredFlag | SafePredFlag);
1563#endif
1564#ifdef DEBUG
1565 Yap_InitCPred("dump_active_goals", 0, p_dump_active_goals,
1566 SafePredFlag | SyncPredFlag);
1567#endif
1568
1569 Yap_InitArrayPreds();
1570 Yap_InitAtomPreds();
1571 Yap_InitBBPreds();
1572 Yap_InitBigNums();
1573 Yap_InitCdMgr();
1574 Yap_InitCmpPreds();
1575 Yap_InitCopyTerm();
1576 Yap_InitCoroutPreds();
1577 Yap_InitDBPreds();
1578 Yap_InitErrorPreds();
1579 Yap_InitExecFs();
1580 Yap_InitGlobals();
1581 Yap_InitInlines();
1582 Yap_InitIOPreds();
1583 Yap_InitExoPreds();
1584 Yap_InitLoadForeign();
1585 Yap_InitModulesC();
1586 Yap_InitSavePreds();
1587 Yap_InitRange();
1588 Yap_InitSysPreds();
1589 Yap_InitUnify();
1590 Yap_InitQLY();
1591 Yap_InitQLYR();
1592 Yap_InitStInfo();
1593 Yap_udi_init();
1594 Yap_udi_Interval_init();
1595 Yap_InitSignalCPreds();
1596 Yap_InitUserCPreds();
1597 Yap_InitUtilCPreds();
1598 Yap_InitTermCPreds();
1599 Yap_InitSortPreds();
1600 Yap_InitMaVarCPreds();
1601#ifdef DEPTH_LIMIT
1602 Yap_InitItDeepenPreds();
1603#endif
1604#ifdef ANALYST
1605 Yap_InitAnalystPreds();
1606#endif
1607 Yap_InitLowLevelTrace();
1608 Yap_InitEval();
1609 Yap_InitGrowPreds();
1610 Yap_InitLowProf();
1611#if defined(YAPOR) || defined(TABLING)
1612 Yap_init_optyap_preds();
1613#endif /* YAPOR || TABLING */
1614#if YAP_JIT
1615 Yap_InitCPred("jit", 0, p_jit, SafePredFlag | SyncPredFlag);
1616#endif
1617 Yap_InitThreadPreds();
1618 {
1619 void (*(*(p)))(void) = E_Modules;
1620 while (*p)
1621 (*(*p++))();
1622 }
1623#if USE_MYDDAS
1624 init_myddas();
1625#endif
1626#if CAMACHO
1627 {
1628 extern void InitForeignPreds(void);
1629
1630 Yap_InitForeignPreds();
1631 }
1632#endif
1633#if APRIL
1634 {
1635 extern void init_ol(void), init_time(void);
1636
1637 init_ol();
1638 init_time();
1639 }
1640#endif
1641#if SUPPORT_CONDOR
1642 init_sys();
1643 init_random();
1644 init_regexp();
1645#endif
1646}
Foreign.h
load_foreign_files/3 has works for the following configurations:
Yap.h
Main definitions.
Yap_AbsoluteFile
const char * Yap_AbsoluteFile(const char *spec, bool ok)
generate absolute path, if ok first expand SICStus Prolog style
Definition: absf.c:145
Yap_InitCPreds
Definition: stdpreds.c:1481
Malloc
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
m
A matrix.
Definition: matrix.c:68
mod_entry
Module property: low-level data used to manage modes.
Definition: Yatom.h:209
operator_entry
Definition: Yatom.h:295
pred_entry
Definition: Yatom.h:544
yami
Definition: amidefs.h:264