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
18 static 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 #include <stdlib.h>
27 #include "Yap.h"
28 #include "yapio.h"
29 #include "alloc.h"
30 #include "clause.h"
31 #include "Foreign.h"
32
33 #ifdef LOW_LEVEL_TRACER
34 #include "tracer.h"
35 #endif
36 #ifdef YAPOR
37 #include "or.macros.h"
38 #endif /* YAPOR */
39 #if defined(YAPOR) || defined(TABLING)
40 #if HAVE_SYS_TYPES_H
41 #include <sys/types.h>
42 #endif
43 #if HAVE_SYS_STAT_H
44 #include <sys/stat.h>
45 #endif
46 #if HAVE_FCNTL_H
47 #include <fcntl.h>
48 #endif
49 #endif /* YAPOR || TABLING */
50 #if HAVE_STRING_H
51 #include <string.h>
52 #endif
53
54 #ifdef DEBUG
55
56 #define LOGFILE "logfile"
57
58 int Yap_output_msg = FALSE;
59
60 #ifdef MACC
61 STATIC_PROTO(void InTTYLine, (char *));
62 #endif
63 #endif
64 STATIC_PROTO(void SetOp, (int, int, char *, Term));
65 STATIC_PROTO(void InitOps, (void));
66 STATIC_PROTO(void InitDebug, (void));
67 #ifdef CUT_C
68 STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate, CPredicate));
69 #else
70 STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate));
71 #endif
72 STATIC_PROTO(void InitStdPreds,(void));
73 STATIC_PROTO(void InitFlags, (void));
74 STATIC_PROTO(void InitCodes, (void));
75 STATIC_PROTO(void InitVersion, (void));
76
77
78 STD_PROTO(void exit, (int));
79
80 /************** YAP PROLOG GLOBAL VARIABLES *************************/
81
82 /************* variables related to memory allocation ***************/
83
84 #if defined(THREADS)
85
86 ADDR Yap_HeapBase;
87
88 struct restore_info rinfo[MAX_THREADS];
89
90 struct thread_globs Yap_thread_gl[MAX_THREADS];
91
92 pthread_t Yap_master_thread;
93
94 #else
95
96 struct restore_info rinfo;
97
98 ADDR Yap_HeapBase,
99 Yap_LocalBase,
100 Yap_GlobalBase,
101 Yap_TrailBase,
102 Yap_TrailTop;
103
104 /************ variables concerned with Error Handling *************/
105 char *Yap_ErrorMessage; /* used to pass error messages */
106 Term Yap_Error_Term; /* used to pass error terms */
107 yap_error_number Yap_Error_TYPE; /* used to pass the error */
108 UInt Yap_Error_Size; /* used to pass a size associated with an error */
109
110 /******************* storing error messages ****************************/
111 char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
112
113 /* if we botched in a LongIO operation */
114 jmp_buf Yap_IOBotch;
115
116 /* if we botched in the compiler */
117 jmp_buf Yap_CompilerBotch;
118
119 /************ variables concerned with Error Handling *************/
120 sigjmp_buf Yap_RestartEnv; /* used to restart after an abort execution */
121
122 /********* IO support *****/
123
124 /********* parsing ********************************************/
125
126 TokEntry *Yap_tokptr, *Yap_toktide;
127 VarEntry *Yap_VarTable, *Yap_AnonVarTable;
128 int Yap_eot_before_eof = FALSE;
129
130 /******************* intermediate buffers **********************/
131
132 char Yap_FileNameBuf[YAP_FILENAME_MAX],
133 Yap_FileNameBuf2[YAP_FILENAME_MAX];
134
135 #endif /* THREADS */
136
137 /******** whether Yap is responsible for signal handling******************/
138 int Yap_PrologShouldHandleInterrupts;
139
140 /********* readline support *****/
141 #if HAVE_LIBREADLINE
142
143 char *_line = (char *) NULL;
144
145 #endif
146
147 #ifdef MPWSHELL
148 /********** informing if we are in the MPW shell ********************/
149
150 int mpwshell = FALSE;
151
152 #endif
153
154 #ifdef EMACS
155
156 int emacs_mode = FALSE;
157 char emacs_tmp[256], emacs_tmp2[256];
158
159 #endif
160
161 /********* Prolog State ********************************************/
162
163 Int Yap_PrologMode = BootMode;
164
165 int Yap_CritLocks = 0;
166
167 /********* streams ********************************************/
168
169 YP_FILE *Yap_stdin;
170 YP_FILE *Yap_stdout;
171 YP_FILE *Yap_stderr;
172
173
174 /************** Access to yap initial arguments ***************************/
175
176 char **Yap_argv;
177 int Yap_argc;
178
179 /************** Extensions to Terms ***************************************/
180
181 #ifdef COROUTINING
182 /* array with the ops for your favourite extensions */
183 ext_op attas[attvars_ext+1];
184 #endif
185
186 /************** declarations local to init.c ************************/
187 static char *optypes[] =
188 {"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"};
189
190 /* OS page size for memory allocation */
191 int Yap_page_size;
192
193 #if USE_THREADED_CODE
194 /* easy access to instruction opcodes */
195 void **Yap_ABSMI_OPCODES;
196 #endif
197
198 #if USE_SOCKET
199 int Yap_sockets_io=0;
200 #endif
201
202 #if DEBUG
203 #if COROUTINING
204 int Yap_Portray_delays = FALSE;
205 #endif
206 #endif
207
208 #define xfx 1
209 #define xfy 2
210 #define yfx 3
211 #define xf 4
212 #define yf 5
213 #define fx 6
214 #define fy 7
215
216 int
Yap_IsOpType(char * type)217 Yap_IsOpType(char *type)
218 {
219 int i;
220
221 for (i = 1; i <= 7; ++i)
222 if (strcmp(type, optypes[i]) == 0)
223 break;
224 return (i <= 7);
225 }
226
227 static int
OpDec(int p,char * type,Atom a,Term m)228 OpDec(int p, char *type, Atom a, Term m)
229 {
230 int i;
231 AtomEntry *ae = RepAtom(a);
232 OpEntry *info;
233
234 if (m == TermProlog)
235 m = PROLOG_MODULE;
236 else if (m == USER_MODULE)
237 m = PROLOG_MODULE;
238 for (i = 1; i <= 7; ++i)
239 if (strcmp(type, optypes[i]) == 0)
240 break;
241 if (i > 7) {
242 Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER,MkAtomTerm(Yap_LookupAtom(type)),"op/3");
243 return(FALSE);
244 }
245 if (p) {
246 if (i == 1 || i == 2 || i == 4)
247 p |= DcrlpFlag;
248 if (i == 1 || i == 3 || i == 6)
249 p |= DcrrpFlag;
250 }
251 WRITE_LOCK(ae->ARWLock);
252 info = Yap_GetOpPropForAModuleHavingALock(ae, m);
253 if (EndOfPAEntr(info)) {
254 info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
255 info->KindOfPE = Ord(OpProperty);
256 info->NextOfPE = RepAtom(a)->PropsOfAE;
257 info->OpModule = m;
258 info->OpName = a;
259 LOCK(OpListLock);
260 info->OpNext = OpList;
261 OpList = info;
262 UNLOCK(OpListLock);
263 RepAtom(a)->PropsOfAE = AbsOpProp(info);
264 INIT_RWLOCK(info->OpRWLock);
265 WRITE_LOCK(info->OpRWLock);
266 WRITE_UNLOCK(ae->ARWLock);
267 info->Prefix = info->Infix = info->Posfix = 0;
268 } else {
269 WRITE_LOCK(info->OpRWLock);
270 WRITE_UNLOCK(ae->ARWLock);
271 }
272 if (i <= 3) {
273 if (yap_flags[STRICT_ISO_FLAG] &&
274 info->Posfix != 0) /* there is a posfix operator */ {
275 /* ISO dictates */
276 WRITE_UNLOCK(info->OpRWLock);
277 Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
278 return FALSE;
279 }
280 info->Infix = p;
281 } else if (i <= 5) {
282 if (yap_flags[STRICT_ISO_FLAG] &&
283 info->Infix != 0) /* there is an infix operator */ {
284 /* ISO dictates */
285 WRITE_UNLOCK(info->OpRWLock);
286 Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
287 return FALSE;
288 }
289 info->Posfix = p;
290 } else {
291 info->Prefix = p;
292 }
293 WRITE_UNLOCK(info->OpRWLock);
294 return (TRUE);
295 }
296
297 int
Yap_OpDec(int p,char * type,Atom a,Term m)298 Yap_OpDec(int p, char *type, Atom a, Term m)
299 {
300 return(OpDec(p,type,a,m));
301 }
302
303 static void
SetOp(int p,int type,char * at,Term m)304 SetOp(int p, int type, char *at, Term m)
305 {
306 #ifdef DEBUG
307 if (Yap_Option[5])
308 fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at);
309 #endif
310 OpDec(p, optypes[type], Yap_LookupAtom(at), m);
311 }
312
313 /* Gets the info about an operator in a prop */
314 Atom
Yap_GetOp(OpEntry * pp,int * prio,int fix)315 Yap_GetOp(OpEntry *pp, int *prio, int fix)
316 {
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
346 typedef struct OPSTRUCT {
347 char *opName;
348 short int opType, opPrio;
349 } Opdef;
350
351 static Opdef Ops[] = {
352 {":-", xfx, 1200},
353 {"-->", xfx, 1200},
354 {"?-", fx, 1200},
355 {":-", fx, 1200},
356 {"dynamic", fx, 1150},
357 {"thread_local", fx, 1150},
358 {"initialization", fx, 1150},
359 {"volatile", fx, 1150},
360 {"mode", fx, 1150},
361 {"public", fx, 1150},
362 {"multifile", fx, 1150},
363 {"meta_predicate", fx, 1150},
364 {"module_transparent", fx, 1150},
365 {"discontiguous", fx, 1150},
366 #ifdef YAPOR
367 {"sequential", fx, 1150},
368 #endif /* YAPOR */
369 #ifdef TABLING
370 {"table", fx, 1150},
371 #endif /* TABLING */
372 #ifndef UNCUTABLE
373 {"uncutable", fx, 1150},
374 #endif /*UNCUTABLE ceh:*/
375 {"|", xfy, 1105},
376 {";", xfy, 1100},
377 /* {";", yf, 1100}, not allowed in ISO */
378 {"->", xfy, 1050},
379 {"*->", xfy, 1050},
380 {",", xfy, 1000},
381 {".", xfy, 999},
382 {"\\+", fy, 900},
383 {"not", fy, 900},
384 {"=", xfx, 700},
385 {"\\=", xfx, 700},
386 {"is", 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 {">=", xfx, 700},
402 {"as", xfx, 600},
403 {":", xfy, 600},
404 {"+", yfx, 500},
405 {"-", yfx, 500},
406 {"/\\", yfx, 500},
407 {"\\/", yfx, 500},
408 {"><", yfx, 500},
409 {"#", yfx, 500},
410 {"rdiv", yfx, 400},
411 {"div", 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 };
426
427 static void
InitOps(void)428 InitOps(void)
429 {
430 unsigned int i;
431 for (i = 0; i < sizeof(Ops) / sizeof(*Ops); ++i)
432 SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName, PROLOG_MODULE);
433 }
434
435 #ifdef DEBUG
436 #ifdef HAVE_ISATTY
437 #include <unistd.h>
438 #endif
439 #endif
440
441 static void
InitDebug(void)442 InitDebug(void)
443 {
444 Atom At;
445 #ifdef DEBUG
446 int i;
447
448 for (i = 1; i < 20; ++i)
449 Yap_Option[i] = 0;
450 if (Yap_output_msg) {
451 char ch;
452
453 #if HAVE_ISATTY
454 if (!isatty (0)) {
455 return;
456 }
457 #endif
458 fprintf(stderr,"absmi address:%p\n", FunAdr(Yap_absmi));
459 fprintf(stderr,"Set Trace Options:\n");
460 fprintf(stderr,"a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n");
461 fprintf(stderr,"e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n");
462 fprintf(stderr,"m Machine\t p parser\n");
463 while ((ch = YP_putchar(YP_getchar())) != '\n')
464 if (ch >= 'a' && ch <= 'z')
465 Yap_Option[ch - 'a' + 1] = 1;
466 if (Yap_Option['l' - 96]) {
467 Yap_logfile = fopen(LOGFILE, "w");
468 if (Yap_logfile == NULL) {
469 fprintf(stderr,"can not open %s\n", LOGFILE);
470 getchar();
471 exit(0);
472 }
473 fprintf(stderr,"logging session to file 'logfile'\n");
474 #ifdef MAC
475 Yap_SetTextFile(LOGFILE);
476 lp = my_line;
477 curfile = Nill;
478 #endif
479 }
480 }
481 #endif
482 /* Set at full leash */
483 At = AtomLeash;
484 Yap_PutValue(At, MkIntTerm(15));
485 }
486
487 static UInt
update_flags_from_prolog(UInt flags,PredEntry * pe)488 update_flags_from_prolog(UInt flags, PredEntry *pe)
489 {
490 if (pe->PredFlags & MetaPredFlag)
491 flags |= MetaPredFlag;
492 if (pe->PredFlags & SourcePredFlag)
493 flags |= SourcePredFlag;
494 if (pe->PredFlags & SequentialPredFlag)
495 flags |= SequentialPredFlag;
496 if (pe->PredFlags & MyddasPredFlag)
497 flags |= MyddasPredFlag;
498 if (pe->PredFlags & UDIPredFlag)
499 flags |= UDIPredFlag;
500 if (pe->PredFlags & ModuleTransparentPredFlag)
501 flags |= ModuleTransparentPredFlag;
502 return flags;
503 }
504
505 void
Yap_InitCPred(char * Name,unsigned long int Arity,CPredicate code,UInt flags)506 Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags)
507 {
508 Atom atom = NIL;
509 PredEntry *pe = NULL;
510 yamop *p_code;
511 StaticClause *cl = NULL;
512 Functor f = NULL;
513
514 while (atom == NIL) {
515 atom = Yap_FullLookupAtom(Name);
516 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
517 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
518 return;
519 }
520 }
521 if (Arity) {
522 while (!f) {
523 f = Yap_MkFunctor(atom,Arity);
524 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
525 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
526 return;
527 }
528 }
529 }
530 while (pe == NULL) {
531 if (Arity)
532 pe = RepPredProp(PredPropByFunc(f,CurrentModule));
533 else
534 pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
535 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
536 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
537 return;
538 }
539 }
540 if (pe->PredFlags & CPredFlag) {
541 /* already exists */
542 flags = update_flags_from_prolog(flags, pe);
543 cl = ClauseCodeToStaticClause(pe->CodeOfPred);
544 if ((flags | StandardPredFlag | CPredFlag ) != pe->PredFlags) {
545 Yap_ClauseSpace -= cl->ClSize;
546 Yap_FreeCodeSpace((ADDR)cl);
547 cl = NULL;
548 }
549 }
550 p_code = cl->ClCode;
551 while (!cl) {
552 UInt sz;
553
554 if (flags & SafePredFlag) {
555 sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code,Osbpp),p),l);
556 } else {
557 sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code,e),p),Osbpp),p),l);
558 }
559 cl = (StaticClause *)Yap_AllocCodeSpace(sz);
560 if (!cl) {
561 if (!Yap_growheap(FALSE, sz, NULL)) {
562 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
563 return;
564 }
565 } else {
566 Yap_ClauseSpace += sz;
567 cl->ClFlags = StaticMask;
568 cl->ClNext = NULL;
569 cl->ClSize = sz;
570 cl->usc.ClPred = pe;
571 p_code = cl->ClCode;
572 }
573 }
574 pe->CodeOfPred = p_code;
575 pe->PredFlags = flags | StandardPredFlag | CPredFlag;
576 pe->cs.f_code = code;
577 if (!(flags & SafePredFlag)) {
578 p_code->opc = Yap_opcode(_allocate);
579 p_code = NEXTOP(p_code,e);
580 }
581 if (flags & UserCPredFlag)
582 p_code->opc = Yap_opcode(_call_usercpred);
583 else
584 p_code->opc = Yap_opcode(_call_cpred);
585 p_code->u.Osbpp.bmap = NULL;
586 p_code->u.Osbpp.s = -Signed(RealEnvSize);
587 p_code->u.Osbpp.p =
588 p_code->u.Osbpp.p0 =
589 pe;
590 p_code = NEXTOP(p_code,Osbpp);
591 if (!(flags & SafePredFlag)) {
592 p_code->opc = Yap_opcode(_deallocate);
593 p_code->u.p.p = pe;
594 p_code = NEXTOP(p_code,p);
595 }
596 p_code->opc = Yap_opcode(_procceed);
597 p_code->u.p.p = pe;
598 p_code = NEXTOP(p_code,p);
599 p_code->opc = Yap_opcode(_Ystop);
600 p_code->u.l.l = cl->ClCode;
601 pe->OpcodeOfPred = pe->CodeOfPred->opc;
602 }
603
604 void
Yap_InitCmpPred(char * Name,unsigned long int Arity,CmpPredicate cmp_code,UInt flags)605 Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, UInt flags)
606 {
607 Atom atom = NIL;
608 PredEntry *pe = NULL;
609 yamop *p_code = NULL;
610 StaticClause *cl = NULL;
611 Functor f = NULL;
612
613 while (atom == NIL) {
614 atom = Yap_FullLookupAtom(Name);
615 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
616 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
617 return;
618 }
619 }
620 if (Arity) {
621 while (!f) {
622 f = Yap_MkFunctor(atom,Arity);
623 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
624 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
625 return;
626 }
627 }
628 }
629 while (pe == NULL) {
630 if (Arity)
631 pe = RepPredProp(PredPropByFunc(f,CurrentModule));
632 else
633 pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
634 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
635 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
636 return;
637 }
638 }
639 if (pe->PredFlags & CPredFlag) {
640 flags = update_flags_from_prolog(flags, pe);
641 p_code = pe->CodeOfPred;
642 /* already exists */
643 } else {
644 while (!cl) {
645 UInt sz = sizeof(StaticClause)+(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL),plxxs),p),l);
646 cl = (StaticClause *)Yap_AllocCodeSpace(sz);
647 if (!cl) {
648 if (!Yap_growheap(FALSE, sz, NULL)) {
649 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
650 return;
651 }
652 } else {
653 Yap_ClauseSpace += sz;
654 cl->ClFlags = StaticMask;
655 cl->ClNext = NULL;
656 cl->ClSize = sz;
657 cl->usc.ClPred = pe;
658 p_code = cl->ClCode;
659 break;
660 }
661 }
662 }
663 pe->PredFlags = flags | StandardPredFlag | CPredFlag;
664 pe->CodeOfPred = p_code;
665 pe->cs.d_code = cmp_code;
666 pe->ModuleOfPred = CurrentModule;
667 p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
668 p_code->u.plxxs.p = pe;
669 p_code->u.plxxs.f = FAILCODE;
670 p_code->u.plxxs.x1 = Yap_emit_x(1);
671 p_code->u.plxxs.x2 = Yap_emit_x(2);
672 p_code->u.plxxs.flags = Yap_compile_cmp_flags(pe);
673 p_code = NEXTOP(p_code,plxxs);
674 p_code->opc = Yap_opcode(_procceed);
675 p_code->u.p.p = pe;
676 p_code = NEXTOP(p_code,p);
677 p_code->opc = Yap_opcode(_Ystop);
678 p_code->u.l.l = cl->ClCode;
679 }
680
681 void
Yap_InitAsmPred(char * Name,unsigned long int Arity,int code,CPredicate def,UInt flags)682 Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, UInt flags)
683 {
684 Atom atom = NIL;
685 PredEntry *pe = NULL;
686 Functor f = NULL;
687
688 while (atom == NIL) {
689 atom = Yap_FullLookupAtom(Name);
690 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
691 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
692 return;
693 }
694 }
695 if (Arity) {
696 while (!f) {
697 f = Yap_MkFunctor(atom,Arity);
698 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
699 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
700 return;
701 }
702 }
703 }
704 while (pe == NULL) {
705 if (Arity)
706 pe = RepPredProp(PredPropByFunc(f,CurrentModule));
707 else
708 pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
709 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
710 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
711 return;
712 }
713 }
714 flags |= AsmPredFlag | StandardPredFlag | (code);
715 if (pe->PredFlags & AsmPredFlag) {
716 flags = update_flags_from_prolog(flags, pe);
717 /* already exists */
718 }
719 pe->PredFlags = flags;
720 pe->cs.f_code = def;
721 pe->ModuleOfPred = CurrentModule;
722 if (def != NULL) {
723 yamop *p_code = ((StaticClause *)NULL)->ClCode;
724 StaticClause *cl;
725
726 if (pe->CodeOfPred == (yamop *)(&(pe->OpcodeOfPred))) {
727 if (flags & SafePredFlag) {
728 cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),Osbpp),p),l));
729 } else {
730 cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),Osbpp),p),p),l));
731 }
732 if (!cl) {
733 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitAsmPred");
734 return;
735 }
736 Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),Osbpp),p),l);
737 } else {
738 cl = ClauseCodeToStaticClause(pe->CodeOfPred);
739 }
740 cl->ClFlags = StaticMask;
741 cl->ClNext = NULL;
742 if (flags & SafePredFlag) {
743 cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),Osbpp),e),e);
744 } else {
745 cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),Osbpp),p),e),e);
746 }
747 cl->usc.ClPred = pe;
748 p_code = cl->ClCode;
749 pe->CodeOfPred = p_code;
750 if (!(flags & SafePredFlag)) {
751 p_code->opc = Yap_opcode(_allocate);
752 p_code = NEXTOP(p_code,e);
753 }
754 p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
755 p_code->u.Osbpp.bmap = NULL;
756 p_code->u.Osbpp.s = -Signed(RealEnvSize);
757 p_code->u.Osbpp.p = p_code->u.Osbpp.p0 = pe;
758 p_code = NEXTOP(p_code,Osbpp);
759 if (!(flags & SafePredFlag)) {
760 p_code->opc = Yap_opcode(_deallocate);
761 p_code->u.p.p = pe;
762 p_code = NEXTOP(p_code,p);
763 }
764 p_code->opc = Yap_opcode(_procceed);
765 p_code->u.p.p = pe;
766 p_code = NEXTOP(p_code,p);
767 p_code->opc = Yap_opcode(_Ystop);
768 p_code->u.l.l = cl->ClCode;
769 } else {
770 pe->OpcodeOfPred = Yap_opcode(_undef_p);
771 pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
772 }
773 }
774
775
776 static void
777 #ifdef CUT_C
CleanBack(PredEntry * pe,CPredicate Start,CPredicate Cont,CPredicate Cut)778 CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut)
779 #else
780 CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
781 #endif
782 {
783 yamop *code;
784 if (pe->cs.p_code.FirstClause != pe->cs.p_code.LastClause ||
785 pe->cs.p_code.TrueCodeOfPred != pe->cs.p_code.FirstClause ||
786 pe->CodeOfPred != pe->cs.p_code.FirstClause) {
787 Yap_Error(SYSTEM_ERROR,TermNil,
788 "initiating a C Pred with backtracking");
789 return;
790 }
791 code = (yamop *)(pe->cs.p_code.FirstClause);
792 if (pe->PredFlags & UserCPredFlag)
793 code->opc = Yap_opcode(_try_userc);
794 else
795 code->opc = Yap_opcode(_try_c);
796 #ifdef YAPOR
797 INIT_YAMOP_LTT(code, 2);
798 PUT_YAMOP_SEQ(code);
799 #endif /* YAPOR */
800 code->u.OtapFs.f = Start;
801 code = NEXTOP(code,OtapFs);
802 if (pe->PredFlags & UserCPredFlag)
803 code->opc = Yap_opcode(_retry_userc);
804 else
805 code->opc = Yap_opcode(_retry_c);
806 #ifdef YAPOR
807 INIT_YAMOP_LTT(code, 1);
808 PUT_YAMOP_SEQ(code);
809 #endif /* YAPOR */
810 code->u.OtapFs.f = Cont;
811 #ifdef CUT_C
812 code = NEXTOP(code,OtapFs);
813 if (pe->PredFlags & UserCPredFlag)
814 code->opc = Yap_opcode(_cut_c);
815 else
816 code->opc = Yap_opcode(_cut_userc);
817 code->u.OtapFs.f = Cut;
818 #endif
819 }
820
821
822 #ifdef CUT_C
823 void
Yap_InitCPredBack(char * Name,unsigned long int Arity,unsigned int Extra,CPredicate Start,CPredicate Cont,UInt flags)824 Yap_InitCPredBack(char *Name, unsigned long int Arity,
825 unsigned int Extra, CPredicate Start,
826 CPredicate Cont, UInt flags){
827 Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,NULL,flags);
828 }
829
830 void
Yap_InitCPredBackCut(char * Name,unsigned long int Arity,unsigned int Extra,CPredicate Start,CPredicate Cont,CPredicate Cut,UInt flags)831 Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
832 unsigned int Extra, CPredicate Start,
833 CPredicate Cont,CPredicate Cut, UInt flags){
834 Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,Cut,flags);
835 }
836 #else
Yap_InitCPredBackCut(char * Name,unsigned long int Arity,unsigned int Extra,CPredicate Start,CPredicate Cont,CPredicate Cut,UInt flags)837 Yap_InitCPredBackCut(char *Name, unsigned long int Arity,
838 unsigned int Extra, CPredicate Start,
839 CPredicate Cont,CPredicate Cut, UInt flags){
840 Yap_InitCPredBack(Name,Arity,Extra,Start,Cont,flags);
841 }
842 #endif /* CUT_C */
843
844 void
845 #ifdef CUT_C
Yap_InitCPredBack_(char * Name,unsigned long int Arity,unsigned int Extra,CPredicate Start,CPredicate Cont,CPredicate Cut,UInt flags)846 Yap_InitCPredBack_(char *Name, unsigned long int Arity,
847 unsigned int Extra, CPredicate Start,
848 CPredicate Cont, CPredicate Cut, UInt flags)
849 #else
850 Yap_InitCPredBack(char *Name, unsigned long int Arity,
851 unsigned int Extra, CPredicate Start,
852 CPredicate Cont, UInt flags)
853 #endif
854 {
855 PredEntry *pe = NULL;
856 Atom atom = NIL;
857 Functor f = NULL;
858
859 while (atom == NIL) {
860 atom = Yap_FullLookupAtom(Name);
861 if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
862 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
863 return;
864 }
865 }
866 if (Arity) {
867 while (!f) {
868 f = Yap_MkFunctor(atom,Arity);
869 if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
870 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
871 return;
872 }
873 }
874 }
875 while (pe == NULL) {
876 if (Arity)
877 pe = RepPredProp(PredPropByFunc(f,CurrentModule));
878 else
879 pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
880 if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
881 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
882 return;
883 }
884 }
885 if (pe->cs.p_code.FirstClause != NIL)
886 {
887 flags = update_flags_from_prolog(flags, pe);
888 #ifdef CUT_C
889 CleanBack(pe, Start, Cont, Cut);
890 #else
891 CleanBack(pe, Start, Cont);
892 #endif /*CUT_C*/
893 }
894 else {
895 StaticClause *cl;
896 yamop *code = ((StaticClause *)NULL)->ClCode;
897 if (flags & UserCPredFlag)
898 pe->PredFlags = UserCPredFlag | CompiledPredFlag | StandardPredFlag | flags;
899 else
900 pe->PredFlags = CompiledPredFlag | StandardPredFlag;
901
902 #ifdef YAPOR
903 pe->PredFlags |= SequentialPredFlag;
904 #endif /* YAPOR */
905
906 #ifdef CUT_C
907 cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l));
908 #else
909 cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),l));
910 #endif
911
912 if (cl == NULL) {
913 Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack");
914 return;
915 }
916 cl->ClFlags = StaticMask;
917 cl->ClNext = NULL;
918 #ifdef CUT_C
919 Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l);
920 cl->ClSize =
921 (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e);
922 #else
923 Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),l);
924 cl->ClSize =
925 (CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),e);
926 #endif
927 cl->usc.ClPred = pe;
928
929 code = cl->ClCode;
930 pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
931 pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code;
932 if (flags & UserCPredFlag)
933 pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
934 else
935 pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
936 code->u.OtapFs.f = Start;
937 code->u.OtapFs.p = pe;
938 code->u.OtapFs.s = Arity;
939 code->u.OtapFs.extra = Extra;
940 #ifdef YAPOR
941 INIT_YAMOP_LTT(code, 2);
942 PUT_YAMOP_SEQ(code);
943 #endif /* YAPOR */
944 code = NEXTOP(code,OtapFs);
945 if (flags & UserCPredFlag)
946 code->opc = Yap_opcode(_retry_userc);
947 else
948 code->opc = Yap_opcode(_retry_c);
949 code->u.OtapFs.f = Cont;
950 code->u.OtapFs.p = pe;
951 code->u.OtapFs.s = Arity;
952 code->u.OtapFs.extra = Extra;
953 #ifdef YAPOR
954 INIT_YAMOP_LTT(code, 1);
955 PUT_YAMOP_SEQ(code);
956 #endif /* YAPOR */
957 code = NEXTOP(code,OtapFs);
958 #ifdef CUT_C
959 if (flags & UserCPredFlag)
960 code->opc = Yap_opcode(_cut_userc);
961 else
962 code->opc = Yap_opcode(_cut_c);
963 code->u.OtapFs.f = Cut;
964 code->u.OtapFs.p = pe;
965 code->u.OtapFs.s = Arity;
966 code->u.OtapFs.extra = Extra;
967 code = NEXTOP(code,OtapFs);
968 #endif /* CUT_C */
969 code->opc = Yap_opcode(_Ystop);
970 code->u.l.l = cl->ClCode;
971 }
972 }
973
974
975 static void
InitStdPreds(void)976 InitStdPreds(void)
977 {
978 Yap_InitCPreds();
979 Yap_InitBackCPreds();
980 }
981
982 static void
InitFlags(void)983 InitFlags(void)
984 {
985 /* note that Yap_heap_regs must be set first */
986
987 #if USE_GMP
988 yap_flags[YAP_INT_BOUNDED_FLAG] = 0;
989 #else
990 yap_flags[YAP_INT_BOUNDED_FLAG] = 1;
991 #endif
992 yap_flags[MAX_ARITY_FLAG] = -1;
993 yap_flags[INTEGER_ROUNDING_FLAG] = 0;
994 yap_flags[YAP_MAX_INTEGER_FLAG] = (Int)(~((CELL)1 << (sizeof(Int)*8-1)));
995 yap_flags[YAP_MIN_INTEGER_FLAG] = (Int)(((CELL)1 << (sizeof(Int)*8-1)));
996 yap_flags[CHAR_CONVERSION_FLAG] = 1;
997 yap_flags[YAP_DOUBLE_QUOTES_FLAG] = 1;
998 yap_flags[YAP_TO_CHARS_FLAG] = ISO_TO_CHARS;
999 yap_flags[LANGUAGE_MODE_FLAG] = 0;
1000 yap_flags[STRICT_ISO_FLAG] = FALSE;
1001 yap_flags[SOURCE_MODE_FLAG] = FALSE;
1002 yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES;
1003 yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
1004 #if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR
1005 yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = FALSE;
1006 #else
1007 yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE;
1008 #endif
1009 yap_flags[GENERATE_DEBUG_INFO_FLAG] = TRUE;
1010 /* current default */
1011 yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
1012 yap_flags[TABLING_MODE_FLAG] = 0;
1013 yap_flags[QUIET_MODE_FLAG] = FALSE;
1014 }
1015
1016 static void
InitPredHash(void)1017 InitPredHash(void)
1018 {
1019 UInt i;
1020
1021 PredHash = (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) * PredHashInitialSize);
1022 PredHashTableSize = PredHashInitialSize;
1023 if (PredHash == NULL) {
1024 Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating initial predicate hash table");
1025 }
1026 for (i = 0; i < PredHashTableSize; ++i) {
1027 PredHash[i] = NULL;
1028 }
1029 INIT_RWLOCK(PredHashRWLock);
1030 }
1031
1032 static void
InitEnvInst(yamop start[2],yamop ** instp,op_numbers opc,PredEntry * pred)1033 InitEnvInst(yamop start[2], yamop **instp, op_numbers opc, PredEntry *pred)
1034 {
1035 yamop *ipc = start;
1036
1037 /* make it look like the instruction is preceeded by a call instruction */
1038 ipc->opc = Yap_opcode(_call);
1039 ipc->u.Osbpp.s = -Signed(RealEnvSize);
1040 ipc->u.Osbpp.bmap = NULL;
1041 ipc->u.Osbpp.p = pred;
1042 ipc->u.Osbpp.p0 = pred;
1043 ipc = NEXTOP(ipc, Osbpp);
1044 ipc->opc = Yap_opcode(opc);
1045 *instp = ipc;
1046 }
1047
1048 static void
InitOtaplInst(yamop start[1],OPCODE opc,PredEntry * pe)1049 InitOtaplInst(yamop start[1], OPCODE opc, PredEntry *pe)
1050 {
1051 yamop *ipc = start;
1052
1053 /* this is a place holder, it should not really be used */
1054 ipc->opc = Yap_opcode(opc);
1055 ipc->u.Otapl.s = 0;
1056 ipc->u.Otapl.p = pe;
1057 ipc->u.Otapl.d = NULL;
1058 #ifdef YAPOR
1059 INIT_YAMOP_LTT(ipc, 1);
1060 #endif /* YAPOR */
1061 #ifdef TABLING
1062 ipc->u.Otapl.te = NULL;
1063 #endif /* TABLING */
1064 }
1065
1066 static void
InitDBErasedMarker(void)1067 InitDBErasedMarker(void)
1068 {
1069 Yap_heap_regs->db_erased_marker =
1070 (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct));
1071 Yap_LUClauseSpace += sizeof(DBStruct);
1072 Yap_heap_regs->db_erased_marker->id = FunctorDBRef;
1073 Yap_heap_regs->db_erased_marker->Flags = ErasedMask;
1074 Yap_heap_regs->db_erased_marker->Code = NULL;
1075 Yap_heap_regs->db_erased_marker->DBT.DBRefs = NULL;
1076 Yap_heap_regs->db_erased_marker->Parent = NULL;
1077 }
1078
1079 static void
InitLogDBErasedMarker(void)1080 InitLogDBErasedMarker(void)
1081 {
1082 Yap_heap_regs->logdb_erased_marker =
1083 (LogUpdClause *)Yap_AllocCodeSpace(sizeof(LogUpdClause)+(UInt)NEXTOP((yamop*)NULL,e));
1084 Yap_LUClauseSpace += sizeof(LogUpdClause)+(UInt)NEXTOP((yamop*)NULL,e);
1085 Yap_heap_regs->logdb_erased_marker->Id = FunctorDBRef;
1086 Yap_heap_regs->logdb_erased_marker->ClFlags = ErasedMask|LogUpdMask;
1087 Yap_heap_regs->logdb_erased_marker->ClSource = NULL;
1088 Yap_heap_regs->logdb_erased_marker->ClRefCount = 0;
1089 Yap_heap_regs->logdb_erased_marker->ClPred = PredLogUpdClause;
1090 Yap_heap_regs->logdb_erased_marker->ClExt = NULL;
1091 Yap_heap_regs->logdb_erased_marker->ClPrev = NULL;
1092 Yap_heap_regs->logdb_erased_marker->ClNext = NULL;
1093 Yap_heap_regs->logdb_erased_marker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
1094 Yap_heap_regs->logdb_erased_marker->ClCode->opc = Yap_opcode(_op_fail);
1095 INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker);
1096 }
1097
1098 #define SWIAtomToAtom(X) SWI_Atoms[(X)>>1]
1099
1100 static void
InitSWIAtoms(void)1101 InitSWIAtoms(void)
1102 {
1103 int i=0, j=0;
1104 #include "iswiatoms.h"
1105 Yap_InitSWIHash();
1106 }
1107
1108 static void
InitAtoms(void)1109 InitAtoms(void)
1110 {
1111 int i;
1112 AtomHashTableSize = MaxHash;
1113 HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
1114 if (HashChain == NULL) {
1115 Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating initial atom table");
1116 }
1117 for (i = 0; i < MaxHash; ++i) {
1118 INIT_RWLOCK(HashChain[i].AERWLock);
1119 HashChain[i].Entry = NIL;
1120 }
1121 NOfAtoms = 0;
1122 #if THREADS
1123 SF_STORE->AtFoundVar = Yap_LookupAtom("**");
1124 Yap_ReleaseAtom(AtomFoundVar);
1125 SF_STORE->AtFreeTerm = Yap_LookupAtom("?");
1126 Yap_ReleaseAtom(AtomFreeTerm);
1127 SF_STORE->AtNil = Yap_LookupAtom("[]");
1128 SF_STORE->AtDot = Yap_LookupAtom(".");
1129 #else
1130 Yap_LookupAtomWithAddress("**",&(SF_STORE->AtFoundVar));
1131 Yap_ReleaseAtom(AtomFoundVar);
1132 Yap_LookupAtomWithAddress("?",&(SF_STORE->AtFreeTerm));
1133 Yap_ReleaseAtom(AtomFreeTerm);
1134 Yap_LookupAtomWithAddress("[]",&(SF_STORE->AtNil));
1135 Yap_LookupAtomWithAddress(".",&(SF_STORE->AtDot));
1136 #endif
1137 }
1138
1139 static void
InitWideAtoms(void)1140 InitWideAtoms(void)
1141 {
1142 int i;
1143
1144 WideAtomHashTableSize = MaxWideHash;
1145 WideHashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxWideHash);
1146 if (WideHashChain == NULL) {
1147 Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating wide atom table");
1148 }
1149 for (i = 0; i < MaxWideHash; ++i) {
1150 INIT_RWLOCK(WideHashChain[i].AERWLock);
1151 WideHashChain[i].Entry = NIL;
1152 }
1153 NOfWideAtoms = 0;
1154 }
1155
1156 static void
InitInvisibleAtoms(void)1157 InitInvisibleAtoms(void)
1158 {
1159 /* initialise invisible chain */
1160 Yap_heap_regs->invisiblechain.Entry = NIL;
1161 INIT_RWLOCK(Yap_heap_regs->invisiblechain.AERWLock);
1162 }
1163
1164 #ifdef THREADS
1165 static void
InitThreadHandle(int wid)1166 InitThreadHandle(int wid)
1167 {
1168 FOREIGN_ThreadHandle(wid).in_use = FALSE;
1169 FOREIGN_ThreadHandle(wid).zombie = FALSE;
1170 FOREIGN_ThreadHandle(wid).local_preds = NULL;
1171 #ifdef LOW_LEVEL_TRACER
1172 FOREIGN_ThreadHandle(wid).thread_inst_count = 0LL;
1173 #endif
1174 pthread_mutex_init(&(FOREIGN_ThreadHandle(wid).tlock), NULL);
1175 pthread_mutex_init(&(FOREIGN_ThreadHandle(wid).tlock_status), NULL);
1176 FOREIGN_ThreadHandle(wid).tdetach = (CELL)0;
1177 FOREIGN_ThreadHandle(wid).cmod = (CELL)0;
1178 }
1179 #endif
1180
1181 static void
InitSWIBuffers(int wid)1182 InitSWIBuffers(int wid)
1183 {
1184 int i;
1185
1186 FOREIGN_WL(wid)->SWI_buffers_[0] = malloc(SWI_BUF_SIZE);
1187 FOREIGN_WL(wid)->SWI_buffers_sz_[0] = SWI_BUF_SIZE;
1188 for (i=1; i <= SWI_BUF_RINGS; i++) {
1189 FOREIGN_WL(wid)->SWI_buffers_[i] = NULL;
1190 FOREIGN_WL(wid)->SWI_buffers_sz_[i] = 0;
1191 }
1192 }
1193
1194
1195 static void
InitFirstWorkerThreadHandle(void)1196 InitFirstWorkerThreadHandle(void)
1197 {
1198 #ifdef THREADS
1199 ThreadHandle.id = 0;
1200 ThreadHandle.in_use = TRUE;
1201 ThreadHandle.default_yaam_regs =
1202 &Yap_standard_regs;
1203 ThreadHandle.pthread_handle = pthread_self();
1204 pthread_mutex_init(&FOREIGN_ThreadHandle(0).tlock, NULL);
1205 pthread_mutex_init(&FOREIGN_ThreadHandle(0).tlock_status, NULL);
1206 ThreadHandle.tdetach = MkAtomTerm(AtomFalse);
1207 #endif
1208 }
1209
1210 static void
InitScratchPad(int wid)1211 InitScratchPad(int wid)
1212 {
1213 FOREIGN_WL(wid)->scratchpad.ptr = NULL;
1214 FOREIGN_WL(wid)->scratchpad.sz = SCRATCH_START_SIZE;
1215 FOREIGN_WL(wid)->scratchpad.msz = SCRATCH_START_SIZE;
1216 }
1217
1218 void
Yap_CloseScratchPad(void)1219 Yap_CloseScratchPad(void)
1220 {
1221 Yap_FreeCodeSpace(ScratchPad.ptr);
1222 ScratchPad.sz = SCRATCH_START_SIZE;
1223 ScratchPad.msz = SCRATCH_START_SIZE;
1224 }
1225
1226 #include "iglobals.h"
1227
1228 #if defined(YAPOR) || defined(THREADS)
1229 #define MAX_INITS MAX_AGENTS
1230 #else
1231 #define MAX_INITS 1
1232 #endif
1233
1234 #if defined(YAPOR) && !defined(THREADS)
1235 struct worker_shared *Yap_global;
1236 #else
1237 struct worker_shared Yap_Global;
1238 #endif
1239
1240 #if defined(YAPOR) && !defined(THREADS)
1241 struct worker_local *Yap_WLocal;
1242 #elif defined(YAPOR) || defined(THREADS)
1243 struct worker_local Yap_WLocal[MAX_AGENTS];
1244 #else
1245 struct worker_local Yap_WLocal;
1246 #endif
1247
1248 static void
InitCodes(void)1249 InitCodes(void)
1250 {
1251 int wid;
1252 #include "ihstruct.h"
1253 InitGlobal();
1254 for (wid = 0; wid < MAX_INITS; wid++) {
1255 InitWorker(wid);
1256 }
1257 InitFirstWorkerThreadHandle();
1258 /* make sure no one else can use these two atoms */
1259 CurrentModule = 0;
1260 Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar));
1261 /* make sure we have undefp defined */
1262 /* predicates can only be defined after this point */
1263 {
1264 /* make sure we know about the module predicate */
1265 PredEntry *modp = RepPredProp(PredPropByFunc(FunctorModule,PROLOG_MODULE));
1266 modp->PredFlags |= MetaPredFlag;
1267 }
1268 #ifdef YAPOR
1269 Yap_heap_regs->getwork_code->u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
1270 Yap_heap_regs->getwork_seq_code->u.Otapl.p = RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE));
1271 #endif /* YAPOR */
1272
1273 }
1274
1275
1276 static void
InitVersion(void)1277 InitVersion(void)
1278 {
1279 Yap_PutValue(AtomVersionNumber,
1280 MkAtomTerm(Yap_LookupAtom(YAP_SVERSION)));
1281 #if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
1282 Yap_PutValue(AtomMyddasVersionName,
1283 MkAtomTerm(Yap_LookupAtom(MYDDAS_VERSION)));
1284 #endif
1285 }
1286
1287 void
Yap_InitWorkspace(UInt Heap,UInt Stack,UInt Trail,UInt Atts,UInt max_table_size,int n_workers,int sch_loop,int delay_load)1288 Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_size,
1289 int n_workers, int sch_loop, int delay_load)
1290 {
1291 int i;
1292
1293 /* initialise system stuff */
1294 #if PUSH_REGS
1295 #ifdef THREADS
1296 pthread_key_create(&Yap_yaamregs_key, NULL);
1297 pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs);
1298 Yap_master_thread = pthread_self();
1299 #else
1300 /* In this case we need to initialise the abstract registers */
1301 Yap_regp = &Yap_standard_regs;
1302 /* the emulator will eventually copy them to its own local
1303 register array, but for now they exist */
1304 #endif
1305 #endif /* PUSH_REGS */
1306
1307 #ifdef THREADS
1308 Yap_regp->worker_id_ = 0;
1309 #endif
1310 /* Init signal handling and time */
1311 /* also init memory page size, required by later functions */
1312 Yap_InitSysbits ();
1313
1314 if (Heap < MinHeapSpace)
1315 Heap = MinHeapSpace;
1316 Heap = AdjustPageSize(Heap * K);
1317 /* sanity checking for data areas */
1318 if (Trail < MinTrailSpace)
1319 Trail = MinTrailSpace;
1320 Trail = AdjustPageSize(Trail * K);
1321 if (Stack < MinStackSpace)
1322 Stack = MinStackSpace;
1323 Stack = AdjustPageSize(Stack * K);
1324 if (!Atts)
1325 Atts = 2048*sizeof(CELL);
1326 else
1327 Atts = AdjustPageSize(Atts * K);
1328 #if defined(YAPOR) && !defined(THREADS)
1329 worker_id = 0;
1330 if (n_workers > MAX_WORKERS)
1331 Yap_Error(INTERNAL_ERROR, TermNil, "excessive number of workers (Yap_InitWorkspace)");
1332 #ifdef ENV_COPY
1333 INFORMATION_MESSAGE("YapOr: copy model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
1334 #elif ACOW
1335 INFORMATION_MESSAGE("YapOr: acow model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
1336 #else /* SBA */
1337 INFORMATION_MESSAGE("YapOr: sba model with %d worker%s", n_workers, n_workers == 1 ? "":"s");
1338 #endif /* ENV_COPY - ACOW - SBA */
1339 map_memory(Heap, Stack+Atts, Trail, n_workers);
1340 #else
1341 Yap_InitMemory (Trail, Heap, Stack+Atts);
1342 #endif /* YAPOR && !THREADS */
1343 #if defined(YAPOR) || defined(TABLING)
1344 Yap_init_global(max_table_size, n_workers, sch_loop, delay_load);
1345 #endif /* YAPOR || TABLING */
1346 Yap_AttsSize = Atts;
1347
1348 Yap_InitTime ();
1349 /* InitAbsmi must be done before InitCodes */
1350 /* This must be done before initialising predicates */
1351 for (i = 0; i <= LAST_FLAG; i++) {
1352 yap_flags[i] = 0;
1353 }
1354 #ifdef MPW
1355 Yap_InitAbsmi(REGS, FunctorList);
1356 #else
1357 Yap_InitAbsmi();
1358 #endif
1359 InitCodes();
1360 InitOps();
1361 InitDebug();
1362 InitVersion();
1363 Yap_InitSysPath();
1364 InitStdPreds();
1365 /* make sure tmp area is available */
1366 {
1367 Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
1368 }
1369 }
1370
1371 int
Yap_HaltRegisterHook(HaltHookFunc f,void * env)1372 Yap_HaltRegisterHook (HaltHookFunc f, void * env)
1373 {
1374 struct halt_hook *h;
1375
1376 if (!(h = (struct halt_hook *)Yap_AllocCodeSpace(sizeof(struct halt_hook))))
1377 return FALSE;
1378 h->environment = env;
1379 h->hook = f;
1380 LOCK(BGL);
1381 h->next = Yap_HaltHooks;
1382 Yap_HaltHooks = h;
1383 UNLOCK(BGL);
1384 return TRUE;
1385 }
1386
1387 static void
run_halt_hooks(int code)1388 run_halt_hooks(int code)
1389 {
1390 struct halt_hook *hooke = Yap_HaltHooks;
1391
1392 while (hooke) {
1393 hooke->hook(code, hooke->environment);
1394 hooke = hooke->next;
1395 }
1396 }
1397
1398 void
Yap_exit(int value)1399 Yap_exit (int value)
1400 {
1401 #if defined(YAPOR) && !defined(THREADS)
1402 unmap_memory();
1403 #endif /* YAPOR */
1404
1405 if (! (Yap_PrologMode & BootMode) ) {
1406 #ifdef LOW_PROF
1407 remove("PROFPREDS");
1408 remove("PROFILING");
1409 #endif
1410 #if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
1411 Yap_MYDDAS_delete_all_myddas_structs();
1412 #endif
1413 run_halt_hooks(value);
1414 Yap_ShutdownLoadForeign();
1415 }
1416 exit(value);
1417 }
1418
1419