YAP 7.1.0
init.c
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: init.c *
12* Last rev: *
13* mods: *
14* comments: initializing a prolog session *
15* *
16*************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
21/*
22 * The code from this file is used to initialize the environment for prolog
23 *
24 */
25
26#define __INIT_C__ 1
27
28#include "Yap.h"
29#include "alloc.h"
30#include "clause.h"
31#include "yapio.h"
32#include <stdlib.h>
33
34#include "Foreign.h"
35
36#ifdef LOW_LEVEL_TRACER
37#include "tracer.h"
38#endif
39#ifdef YAPOR
40#ifdef YAPOR_COW
41#include <signal.h>
42#endif /* YAPOR_COW */
43#include "or.macros.h"
44#endif /* YAPOR */
45#if defined(YAPOR) || defined(TABLING)
46#if HAVE_SYS_TYPES_H
47#include <sys/types.h>
48#endif
49#if HAVE_SYS_STAT_H
50#include <sys/stat.h>
51#endif
52#if HAVE_FCNTL_H
53#include <fcntl.h>
54#endif
55#endif /* YAPOR || TABLING */
56#if HAVE_STRING_H
57#include <string.h>
58#include <stdnoreturn.h>
59
60#endif
61
62#ifndef YAPOR
63Atom AtomFoundVar, AtomFreeTerm, AtomNil, AtomDot;
64#endif // !YAPOR
65
66bool Yap_Embedded = false;
67
68int Yap_output_msg = FALSE;
69const char *Yap_BOOTFILE;
70#if DEBUG
71
72#define LOGFILE "logfile"
73
74#ifdef MACC
75static void InTTYLine(char *);
76#endif
77#endif
78static void SetOp(int, int, char *, Term);
79static void InitOps(void);
80static void InitDebug(void);
81static void CleanBack(PredEntry *, CPredicate, CPredicate, CPredicate);
82static void InitStdPreds(struct yap_boot_params *yapi);
83static void InitCodes(struct yap_boot_params *yapi);
84static void InitVersion(void);
85extern void exit(int);
86static void InitWorker(int wid);
87
88/************** YAP PROLOG GLOBAL VARIABLES *************************/
89
90/************* variables related to memory allocation ***************/
91ADDR Yap_HeapBase;
92
93/************** declarations local to init.c ************************/
94static char *optypes[] = {"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"};
95
96/* OS page size for memory allocation */
97size_t Yap_page_size;
98
99#if DEBUG
100#if COROUTINING
101int Yap_Portray_delays = FALSE;
102#endif
103#endif
104
105void *YAP_save;
106
191#define xfx 1
192#define xfy 2
193#define yfx 3
194#define xf 4
195#define yf 5
196#define fx 6
197#define fy 7
198
199int Yap_IsOpType(char *type) {
200 int i;
201
202 for (i = 1; i <= 7; ++i)
203 if (strcmp(type, optypes[i]) == 0)
204 break;
205 return (i <= 7);
206}
207
208static int OpDec(int p, const char *type, Atom a, Term m) {
209 int i;
210 AtomEntry *ae = RepAtom(a);
211 OpEntry *info;
212
213#if defined(MODULE_INDEPENDENT_OPERATORS_FLAG)
214 if (booleanFlag(MODULE_INDEPENDENT_OPERATORS_FLAG)) {
215 m = PROLOG_MODULE;
216 } else
217#endif
218 {
219 if (m == TermProlog)
220 m = PROLOG_MODULE;
221 else if (m == USER_MODULE)
222 m = PROLOG_MODULE;
223 }
224 for (i = 1; i <= 7; ++i)
225 if (strcmp(type, optypes[i]) == 0)
226 break;
227 if (i > 7) {
228 Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER, MkAtomTerm(Yap_LookupAtom(type)),
229 "op/3");
230 return (FALSE);
231 }
232 if (p) {
233 if (i == 1 || i == 2 || i == 4)
234 p |= DcrlpFlag;
235 if (i == 1 || i == 3 || i == 6)
236 p |= DcrrpFlag;
237 }
238 WRITE_LOCK(ae->ARWLock);
239 info = Yap_GetOpPropForAModuleHavingALock(ae, m);
240 if (EndOfPAEntr(info)) {
241 ModEntry *me;
242 info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
243 if (!info)
244 return false;
245 info->KindOfPE = Ord(OpProperty);
246 info->NextForME = (me = Yap_GetModuleEntry(m))->OpForME;
247 me->OpForME = info;
248 info->OpModule = m;
249 info->OpName = a;
250 // LOCK(OpListLock);
251 info->OpNext = OpList;
252 OpList = info;
253 // UNLOCK(OpListLock);
254 AddPropToAtom(ae, (PropEntry *)info);
255 INIT_RWLOCK(info->OpRWLock);
256 WRITE_LOCK(info->OpRWLock);
257 WRITE_UNLOCK(ae->ARWLock);
258 info->Prefix = info->Infix = info->Posfix = 0;
259 } else {
260 WRITE_LOCK(info->OpRWLock);
261 WRITE_UNLOCK(ae->ARWLock);
262 }
263 if (i <= 3) {
264 if (trueGlobalPrologFlag(ISO_FLAG) &&
265 info->Posfix != 0) /* there is a posfix operator */ {
266 /* ISO dictates */
267 WRITE_UNLOCK(info->OpRWLock);
268 Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR, MkAtomTerm(a), "op/3");
269 return false;
270 }
271 info->Infix = p;
272 } else if (i <= 5) {
273
274 if (trueGlobalPrologFlag(ISO_FLAG) &&
275 info->Infix != 0) /* there is an infix operator */ {
276 /* ISO dictates */
277 WRITE_UNLOCK(info->OpRWLock);
278 Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR, MkAtomTerm(a), "op/3");
279 return false;
280 }
281 info->Posfix = p;
282 } else {
283 info->Prefix = p;
284 }
285 WRITE_UNLOCK(info->OpRWLock);
286 return true;
287}
288
289int Yap_OpDec(int p, char *type, Atom a, Term m) {
290 return OpDec(p, type, a, m);
291}
292
293static void SetOp(int p, int type, char *at, Term m) {
294#if DEBUG
295 if (GLOBAL_Option[5])
296 fprintf(stderr, "[setop %d %s %s]\n", p, optypes[type], at);
297#endif
298 OpDec(p, optypes[type], Yap_LookupAtom(at), m);
299}
300
301bool Yap_dup_op(OpEntry *op, ModEntry *she) {
302 AtomEntry *ae = RepAtom(op->OpName);
303 OpEntry *info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
304 if (!info)
305 return false;
306 memcpy(info, op, sizeof(OpEntry));
307 info->NextForME = she->OpForME;
308 she->OpForME = info;
309 info->OpModule = MkAtomTerm(she->AtomOfME);
310 AddPropToAtom(ae, AbsOpProp(info));
311 INIT_RWLOCK(info->OpRWLock);
312 return true;
313}
314
315/* Gets the info about an operator in a prop */
316Atom Yap_GetOp(OpEntry *pp, int *prio, int fix) {
317 int n;
318 SMALLUNSGN p;
319
320 if (fix == 0) {
321 p = pp->Prefix;
322 if (p & DcrrpFlag)
323 n = 6, *prio = (p ^ DcrrpFlag);
324 else
325 n = 7, *prio = p;
326 } else if (fix == 1) {
327 p = pp->Posfix;
328 if (p & DcrlpFlag)
329 n = 4, *prio = (p ^ DcrlpFlag);
330 else
331 n = 5, *prio = p;
332 } else {
333 p = pp->Infix;
334 if ((p & DcrrpFlag) && (p & DcrlpFlag))
335 n = 1, *prio = (p ^ (DcrrpFlag | DcrlpFlag));
336 else if (p & DcrrpFlag)
337 n = 3, *prio = (p ^ DcrrpFlag);
338 else if (p & DcrlpFlag)
339 n = 2, *prio = (p ^ DcrlpFlag);
340 else
341 n = 4, *prio = p;
342 }
343 return Yap_LookupAtom(optypes[n]);
344}
345
346typedef struct OPSTRUCT {
347 char *opName;
348 short int opType, opPrio;
349} Opdef;
350
351static Opdef Ops[] = {{":-", xfx, 1200},
352 {"-->", xfx, 1200},
353 {"?-", fx, 1200},
354 {":-", fx, 1200},
355 {"dynamic", fx, 1150},
356 {"thread_local", fx, 1150},
357 {"initialization", fx, 1150},
358 {"volatile", fx, 1150},
359 {"mode", fx, 1150},
360 {"public", fx, 1150},
361 {"multifile", fx, 1150},
362 {"meta_predicate", fx, 1150},
363 {"module_transparent", fx, 1150},
364 {"discontiguous", fx, 1150},
365#ifdef YAPOR
366 {"sequential", fx, 1150},
367#endif /* YAPOR */
368#ifdef TABLING
369 {"table", fx, 1150},
370#endif /* TABLING */
371#ifndef UNCUTABLE
372 {"uncutable", fx, 1150},
373#endif /*UNCUTABLE ceh:*/
374 {"|", xfy, 1105},
375 {";", xfy, 1100},
376 /* {";", yf, 1100}, not allowed in ISO */
377 {"->", xfy, 1050},
378 {"*->", xfy, 1050},
379 {",", xfy, 1000},
380 {".", xfy, 999},
381 {"\\+", fy, 900},
382 {"not", fy, 900},
383 {"=", xfx, 700},
384 {"\\=", xfx, 700},
385 {"is", xfx, 700},
386 {"=..", xfx, 700},
387 {"==", xfx, 700},
388 {"\\==", xfx, 700},
389 {"@<", xfx, 700},
390 {"@>", xfx, 700},
391 {"@=<", xfx, 700},
392 {"@>=", xfx, 700},
393 {"=@=", xfx, 700},
394 {"\\=@=", xfx, 700},
395 {"=:=", xfx, 700},
396 {"=\\=", xfx, 700},
397 {"<", xfx, 700},
398 {">", xfx, 700},
399 {"=<", xfx, 700},
400 {">=", xfx, 700},
401 {"as", xfx, 600},
402 {":", xfy, 600},
403 {"+", yfx, 500},
404 {"-", yfx, 500},
405 {"/\\", yfx, 500},
406 {"\\/", yfx, 500},
407 {"><", yfx, 500},
408 {"#", yfx, 500},
409 {"rdiv", yfx, 400},
410 {"div", yfx, 400},
411 {"xor", yfx, 400},
412 {"*", yfx, 400},
413 {"/", yfx, 400},
414 {"//", yfx, 400},
415 {"<<", yfx, 400},
416 {">>", yfx, 400},
417 {"mod", yfx, 400},
418 {"rem", yfx, 400},
419 {"+", fy, 200},
420 {"-", fy, 200},
421 {"\\", fy, 200},
422 {"//", yfx, 400},
423 {"**", xfx, 200},
424 {"^", xfy, 200}};
425
426static void InitOps(void) {
427 unsigned int i;
428 for (i = 0; i < sizeof(Ops) / sizeof(*Ops); ++i)
429 SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName, PROLOG_MODULE);
430}
431
433
434#if DEBUG
435#ifdef HAVE_UNISTD_H
436#include <unistd.h>
437#endif
438#endif
439
440static void InitDebug(void) {
441 Atom At;
442#if DEBUG
443 int i;
444
445 for (i = 1; i < 20; ++i)
446 GLOBAL_Option[i] = 0;
447 if (Yap_output_msg) {
448 char ch;
449
450#if _WIN32
451 if (!_isatty(_fileno(stdin))) {
452 return;
453 }
454#elif HAVE_ISATTY
455 if (!isatty(0)) {
456 return;
457 }
458#endif
459 fprintf(stderr, "absmi address:%p\n", FunAdr(Yap_absmi));
460 fprintf(stderr, "Set Trace Options:\n");
461 fprintf(stderr, "a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n");
462 fprintf(stderr, "e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n");
463 fprintf(stderr, "m Machine\t p parser\n");
464 while ((ch = putchar(getchar())) != '\n' && ch != '\r') {
465 if (ch >= 'a' && ch <= 'z')
466 GLOBAL_Option[ch - 'a' + 1] = 1;
467 GLOBAL_Option[ch - 'a' + 1] = 1;
468 }
469 if (GLOBAL_Option['l' - 96]) {
470 GLOBAL_logfile = fopen(LOGFILE, "w");
471 if (GLOBAL_logfile == NULL) {
472 fprintf(stderr, "can not open %s\n", LOGFILE);
473 getchar();
474 exit(0);
475 }
476 fprintf(stderr, "logging session to file 'logfile'\n");
477#ifdef MAC
478 Yap_SetTextFile(LOGFILE);
479 lp = my_line;
480 curfile = Nill;
481#endif
482 }
483 }
484#endif
485 /* Set at full leash */
486 At = AtomLeash;
487 Yap_PutValue(At, MkIntTerm(15));
488}
489
490static UInt update_flags_from_prolog(UInt flags, PredEntry *pe) {
491 if (pe->PredFlags & MetaPredFlag)
492 flags |= MetaPredFlag;
493 if (pe->PredFlags & SourcePredFlag)
494 flags |= SourcePredFlag;
495 if (pe->PredFlags & SequentialPredFlag)
496 flags |= SequentialPredFlag;
497 if (pe->PredFlags & UDIPredFlag)
498 flags |= UDIPredFlag;
499 if (pe->PredFlags & ModuleTransparentPredFlag)
500 flags |= ModuleTransparentPredFlag;
501 if (pe->PredFlags & StandardPredFlag)
502 flags |= StandardPredFlag;
503 return flags;
504}
505
506void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code,
507 pred_flags_t flags) {
508 CACHE_REGS
509 Atom atom = NIL;
510 PredEntry *pe = NULL;
511 yamop *p_code;
512 StaticClause *cl = NULL;
513 Functor f = NULL;
514 Term t;
515
516 while (atom == NIL) {
517 if (flags & UserCPredFlag)
518 atom = Yap_LookupAtom(Name);
519 else
520 atom = Yap_FullLookupAtom(Name);
521 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
522 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
523 return;
524 }
525 }
526 if (Arity == 0) t = MkAtomTerm(atom);
527 else {
528 while (!f) {
529 f = Yap_MkFunctor(atom, Arity);
530 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
531 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
532 return;
533 }
534 }
535 t = Yap_MkNewApplTerm(f,Arity);
536 }
537 while(pe ==NULL) {
538 pe = Yap_new_pred(t, CurrentModule, false, "when initializing C-predicate");
539 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
540 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
541 return;
542 }
543 }
544 if (pe->PredFlags & CPredFlag) {
545 /* already exists */
546 flags = update_flags_from_prolog(flags, pe);
547 cl = ClauseCodeToStaticClause(pe->CodeOfPred);
548 if ((flags | StandardPredFlag | CPredFlag) != pe->PredFlags) {
549 Yap_ClauseSpace -= cl->ClSize;
550 Yap_FreeCodeSpace((ADDR)cl);
551 cl = NULL;
552 }
553 }
554 p_code = cl->ClCode;
555 while (!cl) {
556 UInt sz;
557
558 if (flags & SafePredFlag) {
559 sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code, Osbpp), p), l);
560 } else {
561 sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code, e), p), Osbpp), p),
562 l);
563 }
564 cl = (StaticClause *)Yap_AllocCodeSpace(sz);
565 if (!cl) {
566 if (!Yap_growheap(FALSE, sz, NULL)) {
567 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
568 return;
569 }
570 } else {
571 Yap_ClauseSpace += sz;
572 cl->ClFlags = StaticMask;
573 cl->ClNext = NULL;
574 cl->ClSize = sz;
575 cl->usc.ClLine = Yap_source_line_no();
576 p_code = cl->ClCode;
577 }
578 }
579 pe->CodeOfPred = p_code;
580 pe->PredFlags = flags | StandardPredFlag | CPredFlag;
581 pe->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
582 pe->cs.f_code = code;
583 if (!(flags & SafePredFlag)) {
584 p_code->opc = Yap_opcode(_allocate);
585 p_code = NEXTOP(p_code, e);
586 }
587 if (flags & UserCPredFlag)
588 p_code->opc = Yap_opcode(_call_usercpred);
589 else
590 p_code->opc = Yap_opcode(_call_cpred);
591 p_code->y_u.Osbpp.bmap = NULL;
592 p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
593 p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
594 p_code = NEXTOP(p_code, Osbpp);
595 if (!(flags & SafePredFlag)) {
596 p_code->opc = Yap_opcode(_deallocate);
597 p_code->y_u.p.p = pe;
598 p_code = NEXTOP(p_code, p);
599 }
600 p_code->opc = Yap_opcode(_procceed);
601 p_code->y_u.p.p = pe;
602 p_code = NEXTOP(p_code, p);
603 p_code->opc = Yap_opcode(_Ystop);
604 p_code->y_u.l.l = cl->ClCode;
605 pe->OpcodeOfPred = pe->CodeOfPred->opc;
606}
607
608bool Yap_AddCallToFli(PredEntry *pe, CPredicate call) {
609 yamop *p_code;
610
611 if (pe->PredFlags & BackCPredFlag) {
612 p_code = (yamop *)(pe->cs.p_code.FirstClause);
613 p_code->y_u.OtapFs.f = call;
614 return true;
615 } else if (pe->PredFlags & CPredFlag) {
616 pe->cs.f_code = call;
617 return true;
618 } else {
619 return false;
620 }
621}
622
623bool Yap_AddRetryToFli(PredEntry *pe, CPredicate re) {
624 yamop *p_code;
625
626 if (pe->PredFlags & BackCPredFlag) {
627 p_code = (yamop *)(pe->cs.p_code.FirstClause);
628 p_code = NEXTOP(p_code, OtapFs);
629 p_code->y_u.OtapFs.f = re;
630 return true;
631 } else {
632 return false;
633 }
634}
635
636bool Yap_AddCutToFli(PredEntry *pe, CPredicate CUT) {
637 yamop *p_code;
638
639 if (pe->PredFlags & BackCPredFlag) {
640 p_code = (yamop *)(pe->cs.p_code.FirstClause);
641 p_code = NEXTOP(p_code, OtapFs);
642 p_code = NEXTOP(p_code, OtapFs);
643 p_code->y_u.OtapFs.f = CUT;
644 return true;
645 } else {
646 return false;
647 }
648}
649
650void Yap_InitCmpPred(const char *Name, arity_t Arity, CmpPredicate cmp_code,
651 pred_flags_t flags) {
652 CACHE_REGS
653 Atom atom = NIL;
654 PredEntry *pe = NULL;
655 yamop *p_code = NULL;
656 StaticClause *cl = NULL;
657 Functor f = NULL;
658
659 while (atom == NIL) {
660 atom = Yap_FullLookupAtom(Name);
661 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
662 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
663 return;
664 }
665 }
666 if (Arity) {
667 while (!f) {
668 f = Yap_MkFunctor(atom, Arity);
669 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
670 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
671 return;
672 }
673 }
674 }
675 while (pe == NULL) {
676 if (Arity)
677 pe = RepPredProp(PredPropByFunc(f, CurrentModule));
678 else
679 pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
680 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
681 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
682 return;
683 }
684 }
685 if (pe->PredFlags & BinaryPredFlag) {
686 flags = update_flags_from_prolog(flags, pe);
687 p_code = pe->CodeOfPred;
688 /* already exists */
689 } else {
690 while (!cl) {
691 UInt sz = sizeof(StaticClause) +
692 (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL), plxxs), p), l);
693 cl = (StaticClause *)Yap_AllocCodeSpace(sz);
694 if (!cl) {
695 if (!Yap_growheap(FALSE, sz, NULL)) {
696 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s",
697 Name);
698 return;
699 }
700 } else {
701 Yap_ClauseSpace += sz;
702 cl->ClFlags = StaticMask | StandardPredFlag;
703 cl->ClNext = NULL;
704 cl->ClSize = sz;
705 cl->usc.ClLine = Yap_source_line_no();
706 p_code = cl->ClCode;
707 break;
708 }
709 }
710 }
711 // pe->PredFlags = flags | StandardPredFlag;
712 pe->CodeOfPred = p_code;
713 pe->cs.d_code = cmp_code;
714 pe->ModuleOfPred = CurrentModule;
715 p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
716 p_code->y_u.plxxs.p = pe;
717 p_code->y_u.plxxs.f = FAILCODE;
718 p_code->y_u.plxxs.x1 = Yap_emit_x(1);
719 p_code->y_u.plxxs.x2 = Yap_emit_x(2);
720 p_code->y_u.plxxs.flags = Yap_compile_cmp_flags(pe);
721 p_code = NEXTOP(p_code, plxxs);
722 p_code->opc = Yap_opcode(_procceed);
723 p_code->y_u.p.p = pe;
724 p_code = NEXTOP(p_code, p);
725 p_code->opc = Yap_opcode(_Ystop);
726 p_code->y_u.l.l = cl->ClCode;
727}
728
729void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def,
730 pred_flags_t flags) {
731 CACHE_REGS
732 Atom atom = NIL;
733 PredEntry *pe = NULL;
734 Functor f = NULL;
735
736 while (atom == NIL) {
737 atom = Yap_FullLookupAtom(Name);
738 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
739 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
740 return;
741 }
742 }
743 if (Arity) {
744 while (!f) {
745 f = Yap_MkFunctor(atom, Arity);
746 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
747 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
748 return;
749 }
750 }
751 }
752 while (pe == NULL) {
753 if (Arity)
754 pe = RepPredProp(PredPropByFunc(f, CurrentModule));
755 else
756 pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
757 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
758 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
759 return;
760 }
761 }
762 flags |= AsmPredFlag | StandardPredFlag | (code);
763 if (pe->PredFlags & AsmPredFlag) {
764 flags = update_flags_from_prolog(flags, pe);
765 /* already exists */
766 }
767 pe->PredFlags = flags;
768 pe->cs.f_code = def;
769 pe->ModuleOfPred = CurrentModule;
770 if (def != NULL) {
771 yamop *p_code = ((StaticClause *)NULL)->ClCode;
772 StaticClause *cl;
773
774 if (pe->CodeOfPred == (yamop *)(&(pe->OpcodeOfPred))) {
775 if (flags & SafePredFlag) {
776 cl = (StaticClause *)Yap_AllocCodeSpace(
777 (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l));
778 } else {
779 cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(
780 NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), p),
781 l));
782 }
783 if (!cl) {
784 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitAsmPred");
785 return;
786 }
787 Yap_ClauseSpace +=
788 (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l);
789 } else {
790 cl = ClauseCodeToStaticClause(pe->CodeOfPred);
791 }
792 cl->ClFlags = StaticMask;
793 cl->ClNext = NULL;
794 if (flags & SafePredFlag) {
795 cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), e), e);
796 } else {
797 cl->ClSize = (CELL)NEXTOP(
798 NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), e), e);
799 }
800 cl->usc.ClLine = Yap_source_line_no();
801 p_code = cl->ClCode;
802 pe->CodeOfPred = p_code;
803 if (!(flags & SafePredFlag)) {
804 p_code->opc = Yap_opcode(_allocate);
805 p_code = NEXTOP(p_code, e);
806 }
807 p_code->opc = Yap_opcode(_call_cpred);
808 p_code->y_u.Osbpp.bmap = NULL;
809 p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
810 p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
811 p_code = NEXTOP(p_code, Osbpp);
812 if (!(flags & SafePredFlag)) {
813 p_code->opc = Yap_opcode(_deallocate);
814 p_code->y_u.p.p = pe;
815 p_code = NEXTOP(p_code, p);
816 }
817 p_code->opc = Yap_opcode(_procceed);
818 p_code->y_u.p.p = pe;
819 p_code = NEXTOP(p_code, p);
820 p_code->opc = Yap_opcode(_Ystop);
821 p_code->y_u.l.l = cl->ClCode;
822 pe->OpcodeOfPred = pe->CodeOfPred->opc;
823 } else {
824 pe->OpcodeOfPred = Yap_opcode(_undef_p);
825 pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
826 }
827}
828
829static void CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont,
830 CPredicate Cut) {
831 yamop *code;
832 if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause ||
833 pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause ||
834 pe->CodeOfPred != pe->cs.p_code.FirstClause) {
835 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
836 "initiating a C Pred with backtracking");
837 return;
838 }
839 code = (yamop *)(pe->cs.p_code.FirstClause);
840 code->y_u.OtapFs.p = pe;
841 if (pe->PredFlags & UserCPredFlag)
842 code->opc = Yap_opcode(_try_userc);
843 else
844 code->opc = Yap_opcode(_try_c);
845#ifdef YAPOR
846 INIT_YAMOP_LTT(code, 2);
847 PUT_YAMOP_SEQ(code);
848#endif /* YAPOR */
849 code->y_u.OtapFs.f = Start;
850 code = NEXTOP(code, OtapFs);
851 if (pe->PredFlags & UserCPredFlag)
852 code->opc = Yap_opcode(_retry_userc);
853 else
854 code->opc = Yap_opcode(_retry_c);
855#ifdef YAPOR
856 INIT_YAMOP_LTT(code, 1);
857 PUT_YAMOP_SEQ(code);
858#endif /* YAPOR */
859 code->y_u.OtapFs.f = Cont;
860 code = NEXTOP(code, OtapFs);
861 if (pe->PredFlags & UserCPredFlag)
862 code->opc = Yap_opcode(_cut_c);
863 else
864 code->opc = Yap_opcode(_cut_userc);
865 code->y_u.OtapFs.p = pe;
866 code->y_u.OtapFs.f = Cut;
867}
868
869void Yap_InitCPredBack(const char *Name, arity_t Arity, arity_t Extra,
870 CPredicate Call, CPredicate Retry, pred_flags_t flags) {
871 Yap_InitCPredBack_(Name, Arity, Extra, Call, Retry, NULL, flags);
872}
873
874void Yap_InitCPredBackCut(const char *Name, arity_t Arity, arity_t Extra,
875 CPredicate Start, CPredicate Cont, CPredicate Cut,
876 pred_flags_t flags) {
877 Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, Cut, flags);
878}
879
880void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
881 CPredicate Start, CPredicate Cont, CPredicate Cut,
882 pred_flags_t flags) {
883 CACHE_REGS
884 PredEntry *pe = NULL;
885 Atom atom = NIL;
886 Functor f = NULL;
887
888 while (atom == NIL) {
889 atom = Yap_FullLookupAtom(Name);
890 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
891 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
892 return;
893 }
894 }
895 if (Arity) {
896 while (!f) {
897 f = Yap_MkFunctor(atom, Arity);
898 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
899 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
900 return;
901 }
902 }
903 }
904 while (pe == NULL) {
905 if (Arity)
906 pe = RepPredProp(PredPropByFunc(f, CurrentModule));
907 else
908 pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
909 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
910 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
911 return;
912 }
913 }
914 if (pe->cs.p_code.FirstClause != NIL) {
915 flags = update_flags_from_prolog(flags, pe);
916 CleanBack(pe, Start, Cont, Cut);
917 } else {
918 StaticClause *cl;
919 yamop *code = ((StaticClause *)NULL)->ClCode;
920 UInt sz =
921 (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code, OtapFs), OtapFs), OtapFs), l);
922 if (flags & UserCPredFlag)
923 pe->PredFlags = UserCPredFlag | BackCPredFlag | CompiledPredFlag | flags;
924 else
925 pe->PredFlags = CompiledPredFlag | StandardPredFlag | BackCPredFlag;
926
927#ifdef YAPOR
928 pe->PredFlags |= SequentialPredFlag;
929#endif /* YAPOR */
930
931 cl = (StaticClause *)Yap_AllocCodeSpace(sz);
932
933 if (cl == NULL) {
934 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitCPredBack");
935 return;
936 }
937 cl->ClFlags = StaticMask;
938 cl->ClNext = NULL;
939 Yap_ClauseSpace += sz;
940 cl->ClSize =
941 (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code, OtapFs), OtapFs), OtapFs), e);
942 cl->usc.ClLine = Yap_source_line_no();
943
944 code = cl->ClCode;
945 pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = pe->cs.p_code.FirstClause =
946 pe->cs.p_code.LastClause = code;
947 if (flags & UserCPredFlag)
948 pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
949 else
950 pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
951 code->y_u.OtapFs.f = Start;
952 code->y_u.OtapFs.p = pe;
953 code->y_u.OtapFs.s = Arity;
954 code->y_u.OtapFs.extra = Extra;
955#ifdef YAPOR
956 INIT_YAMOP_LTT(code, 2);
957 PUT_YAMOP_SEQ(code);
958#endif /* YAPOR */
959 code = NEXTOP(code, OtapFs);
960 if (flags & UserCPredFlag)
961 code->opc = Yap_opcode(_retry_userc);
962 else
963 code->opc = Yap_opcode(_retry_c);
964 code->y_u.OtapFs.f = Cont;
965 code->y_u.OtapFs.p = pe;
966 code->y_u.OtapFs.s = Arity;
967 code->y_u.OtapFs.extra = Extra;
968#ifdef YAPOR
969 INIT_YAMOP_LTT(code, 1);
970 PUT_YAMOP_SEQ(code);
971#endif /* YAPOR */
972 code = NEXTOP(code, OtapFs);
973 if (flags & UserCPredFlag)
974 code->opc = Yap_opcode(_cut_userc);
975 else
976 code->opc = Yap_opcode(_cut_c);
977 code->y_u.OtapFs.f = Cut;
978 code->y_u.OtapFs.p = pe;
979 code->y_u.OtapFs.s = Arity;
980 code->y_u.OtapFs.extra = Extra;
981 code = NEXTOP(code, OtapFs);
982 code->opc = Yap_opcode(_Ystop);
983 code->y_u.l.l = cl->ClCode;
984 }
985}
986
987static void InitStdPreds(struct yap_boot_params *yapi)
988{
989 Yap_InitCPreds();
990 Yap_InitBackCPreds();
991 BACKUP_MACHINE_REGS();
992 Yap_InitFlags(false);
993 Yap_InitPlIO(yapi);
994#if HAVE_MPE
995 Yap_InitMPE();
996#endif
997}
998
999static void InitPredHash(void) {
1000 UInt i;
1001
1002 PredHash = (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) *
1003 PredHashInitialSize);
1004 PredHashTableSize = PredHashInitialSize;
1005 if (PredHash == NULL) {
1006 Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0),
1007 "allocating initial predicate hash table");
1008 }
1009 for (i = 0; i < PredHashTableSize; ++i) {
1010 PredHash[i] = NULL;
1011 }
1012 INIT_RWLOCK(PredHashRWLock);
1013}
1014
1015static void InitEnvInst(yamop start[2], yamop **instp, op_numbers opc,
1016 PredEntry *pred) {
1017 yamop *ipc = start;
1018
1019 /* make it look like the instruction is preceeded by a call instruction */
1020 ipc->opc = Yap_opcode(_call);
1021 ipc->y_u.Osbpp.s = -Signed(RealEnvSize);
1022 ipc->y_u.Osbpp.bmap = NULL;
1023 ipc->y_u.Osbpp.p = pred;
1024 ipc->y_u.Osbpp.p0 = pred;
1025 ipc = NEXTOP(ipc, Osbpp);
1026 ipc->opc = Yap_opcode(opc);
1027 *instp = ipc;
1028}
1029
1030static void InitOtaplInst(yamop start[1], OPCODE opc, PredEntry *pe) {
1031 yamop *ipc = start;
1032
1033 /* this is a place holder, it should not really be used */
1034 ipc->opc = Yap_opcode(opc);
1035 ipc->y_u.Otapl.s = 0;
1036 ipc->y_u.Otapl.p = pe;
1037 ipc->y_u.Otapl.d = NULL;
1038#ifdef YAPOR
1039 INIT_YAMOP_LTT(ipc, 1);
1040#endif /* YAPOR */
1041#ifdef TABLING
1042 ipc->y_u.Otapl.te = NULL;
1043#endif /* TABLING */
1044}
1045
1046static void InitDBErasedMarker(void) {
1047 DBErasedMarker = (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct));
1048 Yap_LUClauseSpace += sizeof(DBStruct);
1049 DBErasedMarker->id = FunctorDBRef;
1050 DBErasedMarker->Flags = ErasedMask;
1051 DBErasedMarker->Code = NULL;
1052 DBErasedMarker->DBT.DBRefs = NULL;
1053 DBErasedMarker->Parent = NULL;
1054}
1055
1056static void InitLogDBErasedMarker(void) {
1057 LogDBErasedMarker = (LogUpdClause *)Yap_AllocCodeSpace(
1058 sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e));
1059 Yap_LUClauseSpace += sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e);
1060 LogDBErasedMarker->Id = FunctorDBRef;
1061 LogDBErasedMarker->ClFlags = ErasedMask | LogUpdMask;
1062 LogDBErasedMarker->lusl.ClSource = NULL;
1063 LogDBErasedMarker->ClRefCount = 0;
1064 LogDBErasedMarker->ClExt = NULL;
1065 LogDBErasedMarker->ClPrev = NULL;
1066 LogDBErasedMarker->ClNext = NULL;
1067 LogDBErasedMarker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e);
1068 LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail);
1069 INIT_CLREF_COUNT(LogDBErasedMarker);
1070}
1071
1072static void InitEmptyWakeups(void) {}
1073
1074static void InitAtoms(void) {
1075 int i;
1076 AtomHashTableSize = MaxHash;
1077 HashChain =
1078 (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
1079 if (HashChain == NULL) {
1080 Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0),
1081 "allocating initial atom table");
1082 }
1083 for (i = 0; i < MaxHash; ++i) {
1084 INIT_RWLOCK(HashChain[i].AERWLock);
1085 HashChain[i].Entry = NIL;
1086 }
1087 NOfAtoms = 0;
1088#if 0 && OLD_STYLE_INITIAL_ATOMS
1089 Yap_LookupAtomWithAddress("**", (AtomEntry *)&(SF_STORE->AtFoundVar));
1090 Yap_ReleaseAtom(AtomFoundVar);
1091 Yap_LookupAtomWithAddress("?", (AtomEntry *)&(SF_STORE->AtFreeTerm));
1092 Yap_ReleaseAtom(AtomFreeTerm);
1093 Yap_LookupAtomWithAddress("[]", (AtomEntry *)&(SF_STORE->AtNil));
1094 Yap_LookupAtomWithAddress(".", (AtomEntry *)&(SF_STORE->AtDot));
1095#else
1096 AtomFoundVar = Yap_LookupAtom("**");
1097 Yap_ReleaseAtom(AtomFoundVar);
1098 AtomFreeTerm = Yap_LookupAtom("?");
1099 Yap_ReleaseAtom(AtomFreeTerm);
1100 AtomNil = Yap_LookupAtom("[]");
1101 AtomDot = Yap_LookupAtom(".");
1102#endif
1103}
1104
1105static void InitWideAtoms(void) {
1106 int i;
1107
1108 WideAtomHashTableSize = MaxWideHash;
1109 WideHashChain =
1110 (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxWideHash);
1111 if (WideHashChain == NULL) {
1112 Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0), "allocating wide atom table");
1113 }
1114 for (i = 0; i < MaxWideHash; ++i) {
1115 INIT_RWLOCK(WideHashChain[i].AERWLock);
1116 WideHashChain[i].Entry = NIL;
1117 }
1118 NOfWideAtoms = 0;
1119}
1120
1121static void InitInvisibleAtoms(void) {
1122 /* initialize invisible chain */
1123 INVISIBLECHAIN.Entry = NIL;
1124 INIT_RWLOCK(INVISIBLECHAIN.AERWLock);
1125}
1126
1127#ifdef YAPOR
1128void Yap_init_yapor_workers(void) {
1129 CACHE_REGS
1130 int proc;
1131#ifdef YAPOR_THREADS
1132 return;
1133#endif /* YAPOR_THREADS */
1134#ifdef YAPOR_COW
1135 GLOBAL_master_worker = getpid();
1136 if (GLOBAL_number_workers > 1) {
1137 int son;
1138 son = fork();
1139 if (son == -1)
1140 Yap_Error(SYSTEM_ERROR_FATAL, TermNil,
1141 "fork error (Yap_init_yapor_workers)");
1142 if (son > 0) {
1143 /* I am the father, I must stay here and wait for my children to all die
1144 */
1145 struct sigaction sigact;
1146 sigact.sa_handler = SIG_DFL;
1147 sigemptyset(&sigact.sa_mask);
1148 sigact.sa_flags = SA_RESTART;
1149 sigaction(SIGINT, &sigact, NULL);
1150 pause();
1151 exit(0);
1152 } else
1153 GLOBAL_worker_pid(0) = getpid();
1154 }
1155#endif /* YAPOR_COW */
1156 for (proc = 1; proc < GLOBAL_number_workers; proc++) {
1157 int son;
1158 son = fork();
1159 if (son == -1)
1160 Yap_Error(SYSTEM_ERROR_FATAL, TermNil,
1161 "fork error (Yap_init_yapor_workers)");
1162 if (son == 0) {
1163 /* new worker */
1164 worker_id = proc;
1165 Yap_remap_yapor_memory();
1166 LOCAL = REMOTE(worker_id);
1167 memcpy(REMOTE(worker_id), REMOTE(0), sizeof(struct worker_local));
1168 InitWorker(worker_id);
1169 break;
1170 } else
1171 GLOBAL_worker_pid(proc) = son;
1172 }
1173}
1174#endif /* YAPOR */
1175
1176#ifdef THREADS
1177static void InitThreadHandle(int wid) {
1178 REMOTE_ThreadHandle(wid).in_use = FALSE;
1179 REMOTE_ThreadHandle(wid).zombie = FALSE;
1180 REMOTE_ThreadHandle(wid).local_preds = NULL;
1181#ifdef LOW_LEVEL_TRACER
1182 REMOTE_ThreadHandle(wid).thread_inst_count = 0LL;
1183#endif
1184 pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock), NULL);
1185 pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock_status), NULL);
1186 REMOTE_ThreadHandle(wid).tdetach = (CELL)0;
1187 REMOTE_ThreadHandle(wid).cmod = (CELL)0;
1188 {
1189 mbox_t *mboxp = &REMOTE_ThreadHandle(wid).mbox_handle;
1190 pthread_mutex_t *mutexp;
1191 pthread_cond_t *condp;
1192 struct idb_queue *msgsp;
1193
1194 mboxp->name = MkIntTerm(0);
1195 condp = &mboxp->cond;
1196 pthread_cond_init(condp, NULL);
1197 mutexp = &mboxp->mutex;
1198 pthread_mutex_init(mutexp, NULL);
1199 msgsp = &mboxp->msgs;
1200 mboxp->nmsgs = 0;
1201 mboxp->nclients = 0;
1202 mboxp->open = true;
1203 Yap_init_tqueue(msgsp);
1204 }
1205}
1206
1207int Yap_InitThread(int new_id) {
1208 struct worker_local *new_s;
1209 if (new_id) {
1210 if (!(new_s =
1211 (struct worker_local *)calloc(sizeof(struct worker_local), 1)))
1212 return FALSE;
1213 Yap_local[new_id] = new_s;
1214 if (!((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))) {
1215 REGSTORE *rs = (REGSTORE *)calloc(sizeof(REGSTORE), 1);
1216 pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
1217 REMOTE_ThreadHandle(new_id).default_yaam_regs = rs;
1218 REMOTE_ThreadHandle(new_id).current_yaam_regs = rs;
1219 rs->worker_id_ = new_id;
1220 rs->worker_local_ = REMOTE(new_id);
1221 }
1222 }
1223 InitWorker(new_id);
1224 return TRUE;
1225}
1226#endif
1227
1228static void InitScratchPad(int wid) {
1229 REMOTE_ScratchPad(wid).ptr = NULL;
1230 REMOTE_ScratchPad(wid).sz = SCRATCH_START_SIZE;
1231 REMOTE_ScratchPad(wid).msz = SCRATCH_START_SIZE;
1232}
1233
1234static CELL *InitHandles(int wid) {
1235 size_t initial_slots = 1024;
1236 CELL *handles;
1237
1238 REMOTE_CurSlot(wid) = 1;
1239 REMOTE_NSlots(wid) = initial_slots;
1240 handles = calloc(initial_slots, sizeof(CELL));
1241
1242 if (handles == NULL) {
1243 Yap_Error(SYSTEM_ERROR_INTERNAL, 0 /* TermNil */,
1244 "No space for handles at " __FILE__ " : %d", __LINE__);
1245 }
1246
1247 RESET_VARIABLE(handles);
1248 return handles;
1249}
1250
1251void Yap_CloseScratchPad(void) {
1252 CACHE_REGS
1253 Yap_FreeCodeSpace(LOCAL_ScratchPad.ptr);
1254 LOCAL_ScratchPad.sz = SCRATCH_START_SIZE;
1255 LOCAL_ScratchPad.msz = SCRATCH_START_SIZE;
1256}
1257
1258#include "iglobals.h"
1259
1260#include "ilocals.h"
1261
1262#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
1263struct global_data *Yap_global;
1264long Yap_worker_area_size;
1265
1266#endif
1267
1268#if defined(THREADS)
1269struct worker_local *Yap_local[MAX_THREADS];
1270#elif defined(YAPOR)
1271struct worker_local *Yap_local;
1272#else /* !THREADS && !YAPOR */
1273struct worker_local Yap_local;
1274#endif
1275
1276static void InitCodes(struct yap_boot_params *yapi)
1277{
1278 CACHE_REGS
1279#if THREADS
1280 int wid;
1281 for (wid = 1; wid < MAX_THREADS; wid++) {
1282 Yap_local[wid] = NULL;
1283 }
1284#endif
1285#include "ihstruct.h"
1286#if THREADS
1287 Yap_InitThread(0);
1288#endif /* THREADS */
1289 InitGlobal();
1290#if !THREADS
1291 InitWorker(0);
1292#endif /* THREADS */
1293 Yap_InitFirstWorkerThreadHandle();
1294 /* make sure no one else can use these two atoms */
1295 LOCAL_SourceModule = CurrentModule = 0;
1296 Yap_ReleaseAtom(AtomOfTerm(TermRefoundVar));
1297 /* flags require atom table done, but must be done as soon as possible,
1298 definitely before any predicate initialization */
1299 // Yap_InitFlags(); moved to HEAPFIELDS
1300 /* make sure we have undefp defined */
1301 /* predicates can only be defined after this point */
1302 {
1303 /* make sure we know about the module predicate */
1304 PredEntry *modp = RepPredProp(PredPropByFunc(FunctorModule, PROLOG_MODULE));
1305 modp->PredFlags |= MetaPredFlag;
1306 }
1307#ifdef YAPOR
1308 Yap_heap_regs->getwork_code->y_u.Otapl.p =
1309 RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
1310 Yap_heap_regs->getwork_seq_code->y_u.Otapl.p =
1311 RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE));
1312#endif /* YAPOR */
1313}
1314
1315static void InitVersion(void) {
1316 Yap_PutValue(AtomVersionNumber, MkAtomTerm(Yap_LookupAtom(YAP_FULL_VERSION)));
1317}
1318
1319const char *Yap_version(void) {
1320 Term t = Yap_GetValue(AtomVersionNumber);
1321 return RepAtom(AtomOfTerm(t))->StrOfAE;
1322}
1323
1324void Yap_InitWorkspace(struct yap_boot_params *yapi,
1325 UInt Heap, UInt Stack, UInt Trail, UInt Atts,
1326 UInt max_table_size, int n_workers, int sch_loop,
1327 int delay_load)
1328{
1329 CACHE_REGS
1330
1331/* initialize system stuff */
1332#if PUSH_REGS
1333#ifdef THREADS
1334 if (!(Yap_local[0] =
1335 (struct worker_local *)calloc(sizeof(struct worker_local), 1)))
1336 return;
1337 pthread_key_create(&Yap_yaamregs_key, NULL);
1338 pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs);
1339 GLOBAL_master_thread = pthread_self();
1340#else
1341 /* In this case we need to initialize the abstract registers */
1342 Yap_regp = &Yap_standard_regs;
1343/* the emulator will eventually copy them to its own local
1344 register array, but for now they exist */
1345#endif
1346#endif /* PUSH_REGS */
1347
1348#ifdef THREADS
1349 Yap_regp = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
1350 LOCAL = REMOTE(0);
1351#endif /* THREADS */
1352#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
1353 LOCAL = REMOTE(0);
1354#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
1355 if (Heap < MinHeapSpace)
1356 Heap = MinHeapSpace;
1357 Heap = AdjustPageSize(Heap * K);
1358 Heap /= (K);
1359 /* sanity checking for data areas */
1360 if (Trail < MinTrailSpace)
1361 Trail = MinTrailSpace;
1362 Trail = AdjustPageSize(Trail * K);
1363 Trail /= (K);
1364 if (Stack < MinStackSpace)
1365 Stack = MinStackSpace;
1366 Stack = AdjustPageSize(Stack * K);
1367 Stack /= (K);
1368 if (!Atts)
1369 Atts = 2048 * sizeof(CELL);
1370 else
1371 Atts = AdjustPageSize(Atts * K);
1372 Atts /= (K);
1373#if defined(THREADS) || defined(YAPOR)
1374 worker_id = 0;
1375#endif /* YAPOR || THREADS */
1376#ifdef YAPOR
1377 if (n_workers > MAX_WORKERS)
1378 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "excessive number of workers");
1379#ifdef YAPOR_COPY
1380 INFORMATION_MESSAGE("YapOr: copy model with %d worker%s", n_workers,
1381 n_workers == 1 ? "" : "s");
1382#elif YAPOR_COW
1383 INFORMATION_MESSAGE("YapOr: acow model with %d worker%s", n_workers,
1384 n_workers == 1 ? "" : "s");
1385#elif YAPOR_SBA
1386 INFORMATION_MESSAGE("YapOr: sba model with %d worker%s", n_workers,
1387 n_workers == 1 ? "" : "s");
1388#elif YAPOR_THREADS
1389 INFORMATION_MESSAGE("YapOr: threads model with %d worker%s", n_workers,
1390 n_workers == 1 ? "" : "s");
1391#endif /* YAPOR_COPY - YAPOR_COW - YAPOR_SBA - YAPOR_THREADS */
1392#endif /* YAPOR */
1393#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
1394 Yap_init_yapor_stacks_memory(Trail, Heap, Stack + Atts, n_workers);
1395#else
1396 Yap_InitMemory(Trail, Heap, Stack + Atts);
1397#endif
1398#if defined(YAPOR) || defined(TABLING)
1399 Yap_init_global_optyap_data(max_table_size, n_workers, sch_loop, delay_load);
1400#endif /* YAPOR || TABLING */
1401
1402 Yap_AttsSize = Atts;
1403/* InitAbsmi must be done before InitCodes */
1404/* This must be done before initializing predicates */
1405#ifdef MPW
1406 Yap_InitAbsmi(REGS, FunctorList);
1407#else
1408 Yap_InitAbsmi();
1409#endif
1410 InitCodes(yapi);
1411 InitOps();
1412 InitDebug();
1413 InitVersion();
1414#if THREADS
1415 /* make sure we use the correct value of regcache */
1416 regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
1417#endif
1418#if USE_SYSTEM_MALLOC
1419 if (Trail < MinTrailSpace)
1420 Trail = MinTrailSpace;
1421 if (Stack < MinStackSpace)
1422 Stack = MinStackSpace;
1423 if (!(LOCAL_GlobalBase = (ADDR)calloc((Trail + Stack) , 1024))) {
1424 Yap_Error(RESOURCE_ERROR_HEAP, 0,
1425 "could not allocate stack space for main thread");
1426 Yap_exit(1);
1427 }
1428#if THREADS
1429 /* don't forget this is a thread */
1430 LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase;
1431 LOCAL_ThreadHandle.tsize = Trail;
1432 LOCAL_ThreadHandle.ssize = Stack;
1433#endif
1434#endif
1435 GLOBAL_AllowGlobalExpansion = true;
1436 GLOBAL_AllowLocalExpansion = true;
1437 GLOBAL_AllowTrailExpansion = true;
1438 Yap_InitExStacks(0, Trail, Stack);
1439 Yap_InitYaamRegs(0, true);
1440 InitStdPreds(yapi);
1441 /* make sure tmp area is available */
1442 { Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace()); }
1443}
1444
1445int Yap_HaltRegisterHook(HaltHookFunc f, void *env) {
1446 struct halt_hook *h;
1447
1448 if (!(h = (struct halt_hook *)Yap_AllocCodeSpace(sizeof(struct halt_hook))))
1449 return FALSE;
1450 h->environment = env;
1451 h->hook = f;
1452 LOCK(GLOBAL_BGL);
1453 h->next = GLOBAL_HaltHooks;
1454 GLOBAL_HaltHooks = h;
1455 UNLOCK(GLOBAL_BGL);
1456 return TRUE;
1457}
1458
1459static void run_halt_hooks(int code) {
1460 struct halt_hook *hooke = GLOBAL_HaltHooks;
1461
1462 while (hooke) {
1463 hooke->hook(code, hooke->environment);
1464 hooke = hooke->next;
1465 }
1466}
1467
1468noreturn void Yap_exit(int value) {
1469 CACHE_REGS
1470 void closeFiles(int all);
1471#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
1472 Yap_unmap_yapor_memory();
1473#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
1474
1475 if (!(LOCAL_PrologMode & BootMode)) {
1476#ifdef LOW_PROF
1477 remove("PROFPREDS");
1478 remove("PROFILING");
1479#endif
1480 run_halt_hooks(value);
1481 Yap_ShutdownLoadForeign();
1482 }
1483 Yap_CloseStreams();
1484 Yap_CloseReadline();
1485#if USE_SYSTEM_MALLOC
1486#endif
1487 exit(value);
1488}
Foreign.h
load_foreign_files/3 has works for the following configurations:
Yap.h
Main definitions.
Yap_InitCPreds
Definition: stdpreds.c:1481
OPSTRUCT
Definition: init.c:346
Yap_InitFlags
void Yap_InitFlags(bool bootstrap)
Init System Prolog flags.
Definition: flags.c:2002
DB_STRUCT
Definition: Yatom.h:716
atom_hash_entry
Definition: YapHeap.h:81
global_data
Definition: hglobals.h:21
halt_hook
Definition: YapHeap.h:73
idb_queue
Definition: Yap.h:606
logic_upd_clause
Definition: clause.h:64
m
A matrix.
Definition: matrix.c:68
mod_entry
Module property: low-level data used to manage modes.
Definition: Yatom.h:209
mod_entry::AtomOfME
Atom AtomOfME
index in operator table
Definition: Yatom.h:214
mod_entry::OpForME
struct operator_entry * OpForME
index in module table
Definition: Yatom.h:213
operator_entry
Definition: Yatom.h:295
pred_entry
Definition: Yatom.h:544
regstore_t
Definition: Regs.h:94
static_clause
Definition: clause.h:127
worker_local
Definition: hlocals.h:20
yami
Definition: amidefs.h:264
yap_boot_params
Definition: YapInit.h:22