1 /*************************************************************************
2 * *
3 * YAP Prolog %W% %G%
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: YAtom.h.m4 *
12 * Last rev: 19/2/88 *
13 * mods: *
14 * comments: atom properties header file for YAP *
15 * *
16 *************************************************************************/
17
18 /* This code can only be defined *after* including Regs.h!!! */
19
20 #ifndef YATOM_H
21 #define YATOM_H 1
22
23 #ifdef USE_OFFSETS
24
25 inline EXTERN Atom AbsAtom (AtomEntry * p);
26
27 inline EXTERN Atom
AbsAtom(AtomEntry * p)28 AbsAtom (AtomEntry * p)
29 {
30 return (Atom) (Addr (p) - AtomBase);
31 }
32
33
34
35 inline EXTERN AtomEntry *RepAtom (Atom a);
36
37 inline EXTERN AtomEntry *
RepAtom(Atom a)38 RepAtom (Atom a)
39 {
40 return (AtomEntry *) (AtomBase + Unsigned (a));
41 }
42
43
44 #else
45
46 inline EXTERN Atom AbsAtom (AtomEntry * p);
47
48 inline EXTERN Atom
AbsAtom(AtomEntry * p)49 AbsAtom (AtomEntry * p)
50 {
51 return (Atom) (p);
52 }
53
54
55
56 inline EXTERN AtomEntry *RepAtom (Atom a);
57
58 inline EXTERN AtomEntry *
RepAtom(Atom a)59 RepAtom (Atom a)
60 {
61 return (AtomEntry *) (a);
62 }
63
64
65 #endif
66
67 #if USE_OFFSETS_IN_PROPS
68
69 inline EXTERN Prop AbsProp (PropEntry * p);
70
71 inline EXTERN Prop
AbsProp(PropEntry * p)72 AbsProp (PropEntry * p)
73 {
74 return (Prop) (Addr (p) - AtomBase);
75 }
76
77
78
79 inline EXTERN PropEntry *RepProp (Prop p);
80
81 inline EXTERN PropEntry *
RepProp(Prop p)82 RepProp (Prop p)
83 {
84 return (PropEntry *) (AtomBase + Unsigned (p));
85 }
86
87
88 #else
89
90 inline EXTERN Prop AbsProp (PropEntry * p);
91
92 inline EXTERN Prop
AbsProp(PropEntry * p)93 AbsProp (PropEntry * p)
94 {
95 return (Prop) (p);
96 }
97
98
99
100 inline EXTERN PropEntry *RepProp (Prop p);
101
102 inline EXTERN PropEntry *
RepProp(Prop p)103 RepProp (Prop p)
104 {
105 return (PropEntry *) (p);
106 }
107
108
109 #endif
110
111 #if USE_OFFSETS_IN_PROPS
112
113 inline EXTERN FunctorEntry *RepFunctorProp (Prop p);
114
115 inline EXTERN FunctorEntry *
RepFunctorProp(Prop p)116 RepFunctorProp (Prop p)
117 {
118 return (FunctorEntry *) (AtomBase + Unsigned (p));
119 }
120
121
122
123 inline EXTERN Prop AbsFunctorProp (FunctorEntry * p);
124
125 inline EXTERN Prop
AbsFunctorProp(FunctorEntry * p)126 AbsFunctorProp (FunctorEntry * p)
127 {
128 return (Prop) (Addr (p) - AtomBase);
129 }
130
131
132 #else
133
134 inline EXTERN FunctorEntry *RepFunctorProp (Prop p);
135
136 inline EXTERN FunctorEntry *
RepFunctorProp(Prop p)137 RepFunctorProp (Prop p)
138 {
139 return (FunctorEntry *) (p);
140 }
141
142
143
144 inline EXTERN Prop AbsFunctorProp (FunctorEntry * p);
145
146 inline EXTERN Prop
AbsFunctorProp(FunctorEntry * p)147 AbsFunctorProp (FunctorEntry * p)
148 {
149 return (Prop) (p);
150 }
151
152
153 #endif
154
155
156 inline EXTERN Int ArityOfFunctor (Functor);
157
158 inline EXTERN Int
ArityOfFunctor(Functor Fun)159 ArityOfFunctor (Functor Fun)
160 {
161 return (Int) (((FunctorEntry *) Fun)->ArityOfFE);
162 }
163
164
165
166 inline EXTERN Atom NameOfFunctor (Functor);
167
168 inline EXTERN Atom
NameOfFunctor(Functor Fun)169 NameOfFunctor (Functor Fun)
170 {
171 return (Atom) (((FunctorEntry *) Fun)->NameOfFE);
172 }
173
174
175
176
177 inline EXTERN PropFlags IsFunctorProperty (int);
178
179 inline EXTERN PropFlags
IsFunctorProperty(int flags)180 IsFunctorProperty (int flags)
181 {
182 return (PropFlags) ((flags == FunctorProperty));
183 }
184
185
186
187 /* summary of property codes used
188
189 00 00 predicate entry
190 80 00 db property
191 bb 00 functor entry
192 ff df sparse functor
193 ff ex arithmetic property
194 ff f6 hold
195 ff f7 array
196 ff f8 wide atom
197 ff fa module property
198 ff fb blackboard property
199 ff fc value property
200 ff fd global property
201 ff ff op property
202 */
203
204
205 /* Global Variable property */
206 typedef struct global_entry
207 {
208 Prop NextOfPE; /* used to chain properties */
209 PropFlags KindOfPE; /* kind of property */
210 #if defined(YAPOR) || defined(THREADS)
211 rwlock_t GRWLock; /* a simple lock to protect this entry */
212 #if THREADS
213 unsigned int owner_id; /* owner thread */
214 #endif
215 #endif
216 struct AtomEntryStruct *AtomOfGE; /* parent atom for deletion */
217 struct global_entry *NextGE; /* linked list of global entries */
218 Term global; /* index in module table */
219 Term AttChain; /* index in module table */
220 } GlobalEntry;
221
222
223 #if USE_OFFSETS_IN_PROPS
224
225 inline EXTERN GlobalEntry *RepGlobalProp (Prop p);
226
227 inline EXTERN GlobalEntry *
RepGlobalProp(Prop p)228 RepGlobalProp (Prop p)
229 {
230 return (GlobalEntry *) (AtomBase + Unsigned (p));
231 }
232
233
234
235 inline EXTERN Prop AbsGlobalProp (GlobalEntry * p);
236
237 inline EXTERN Prop
AbsGlobalProp(GlobalEntry * p)238 AbsGlobalProp (GlobalEntry * p)
239 {
240 return (Prop) (Addr (p) - AtomBase);
241 }
242
243
244 #else
245
246 inline EXTERN GlobalEntry *RepGlobalProp (Prop p);
247
248 inline EXTERN GlobalEntry *
RepGlobalProp(Prop p)249 RepGlobalProp (Prop p)
250 {
251 return (GlobalEntry *) (p);
252 }
253
254 inline EXTERN Prop AbsGlobalProp (GlobalEntry * p);
255
256 inline EXTERN Prop
AbsGlobalProp(GlobalEntry * p)257 AbsGlobalProp (GlobalEntry * p)
258 {
259 return (Prop) (p);
260 }
261
262
263 #endif
264
265 #define GlobalProperty ((PropFlags)0xfffd)
266
267 inline EXTERN PropFlags IsGlobalProperty (int);
268
269 inline EXTERN PropFlags
IsGlobalProperty(int flags)270 IsGlobalProperty (int flags)
271 {
272 return (PropFlags) ((flags == GlobalProperty));
273 }
274
275
276 /* Wide Atom property */
277 typedef struct
278 {
279 Prop NextOfPE; /* used to chain properties */
280 PropFlags KindOfPE; /* kind of property */
281 UInt SizeOfAtom; /* index in module table */
282 } WideAtomEntry;
283
284 #if USE_OFFSETS_IN_PROPS
285
286 inline EXTERN WideAtomEntry *RepWideAtomProp (Prop p);
287
288 inline EXTERN WideAtomEntry *
RepWideAtomProp(Prop p)289 RepWideAtomProp (Prop p)
290 {
291 return (WideAtomEntry *) (AtomBase + Unsigned (p));
292 }
293
294
295
296 inline EXTERN Prop AbsWideAtomProp (WideAtomEntry * p);
297
298 inline EXTERN Prop
AbsWideAtomProp(WideAtomEntry * p)299 AbsWideAtomProp (WideAtomEntry * p)
300 {
301 return (Prop) (Addr (p) - AtomBase);
302 }
303
304
305 #else
306
307 inline EXTERN WideAtomEntry *RepWideAtomProp (Prop p);
308
309 inline EXTERN WideAtomEntry *
RepWideAtomProp(Prop p)310 RepWideAtomProp (Prop p)
311 {
312 return (WideAtomEntry *) (p);
313 }
314
315
316
317 inline EXTERN Prop AbsWideAtomProp (WideAtomEntry * p);
318
319 inline EXTERN Prop
AbsWideAtomProp(WideAtomEntry * p)320 AbsWideAtomProp (WideAtomEntry * p)
321 {
322 return (Prop) (p);
323 }
324
325
326 #endif
327
328 #define WideAtomProperty ((PropFlags)0xfff8)
329
330
331 inline EXTERN PropFlags IsWideAtomProperty (int);
332
333 inline EXTERN PropFlags
IsWideAtomProperty(int flags)334 IsWideAtomProperty (int flags)
335 {
336 return (PropFlags) ((flags == WideAtomProperty));
337 }
338
339 inline EXTERN int IsWideAtom (Atom);
340
341 inline EXTERN int
IsWideAtom(Atom at)342 IsWideAtom (Atom at)
343 {
344 return RepAtom(at)->PropsOfAE &&
345 IsWideAtomProperty(RepWideAtomProp(RepAtom(at)->PropsOfAE)->KindOfPE);
346 }
347
348
349 /* Module property */
350 typedef struct mod_entry
351 {
352 Prop NextOfPE; /* used to chain properties */
353 PropFlags KindOfPE; /* kind of property */
354 struct pred_entry *PredForME; /* index in module table */
355 Atom AtomOfME; /* module's name */
356 #if defined(YAPOR) || defined(THREADS)
357 rwlock_t ModRWLock; /* a read-write lock to protect the entry */
358 #endif
359 struct mod_entry *NextME; /* next module */
360 } ModEntry;
361
362 #if USE_OFFSETS_IN_PROPS
363
364 inline EXTERN ModEntry *RepModProp (Prop p);
365
366 inline EXTERN ModEntry *
RepModProp(Prop p)367 RepModProp (Prop p)
368 {
369 return (ModEntry *) (AtomBase + Unsigned (p));
370 }
371
372
373
374 inline EXTERN Prop AbsModProp (ModEntry * p);
375
376 inline EXTERN Prop
AbsModProp(ModEntry * p)377 AbsModProp (ModEntry * p)
378 {
379 return (Prop) (Addr (p) - AtomBase);
380 }
381
382
383 #else
384
385 inline EXTERN ModEntry *RepModProp (Prop p);
386
387 inline EXTERN ModEntry *
RepModProp(Prop p)388 RepModProp (Prop p)
389 {
390 return (ModEntry *) (p);
391 }
392
393
394
395 inline EXTERN Prop AbsModProp (ModEntry * p);
396
397 inline EXTERN Prop
AbsModProp(ModEntry * p)398 AbsModProp (ModEntry * p)
399 {
400 return (Prop) (p);
401 }
402
403
404 #endif
405
406 #define ModProperty ((PropFlags)0xfffa)
407
408
409 inline EXTERN PropFlags IsModProperty (int);
410
411 inline EXTERN PropFlags
IsModProperty(int flags)412 IsModProperty (int flags)
413 {
414 return (PropFlags) ((flags == ModProperty));
415 }
416
417 /* operator property entry structure */
418 typedef struct operator_entry
419 {
420 Prop NextOfPE; /* used to chain properties */
421 PropFlags KindOfPE; /* kind of property */
422 #if defined(YAPOR) || defined(THREADS)
423 rwlock_t OpRWLock; /* a read-write lock to protect the entry */
424 #endif
425 Atom OpName; /* atom name */
426 Term OpModule; /* module of predicate */
427 struct operator_entry *OpNext; /* next in list of operators */
428 BITS16 Prefix, Infix, Posfix; /* precedences */
429 } OpEntry;
430 #if USE_OFFSETS_IN_PROPS
431
432 inline EXTERN OpEntry *RepOpProp (Prop p);
433
434 inline EXTERN OpEntry *
RepOpProp(Prop p)435 RepOpProp (Prop p)
436 {
437 return (OpEntry *) (AtomBase + Unsigned (p));
438 }
439
440 inline EXTERN Prop AbsOpProp (OpEntry * p);
441
442 inline EXTERN Prop
AbsOpProp(OpEntry * p)443 AbsOpProp (OpEntry * p)
444 {
445 return (Prop) (Addr (p) - AtomBase);
446 }
447
448
449 #else
450
451 inline EXTERN OpEntry *RepOpProp (Prop p);
452
453 inline EXTERN OpEntry *
RepOpProp(Prop p)454 RepOpProp (Prop p)
455 {
456 return (OpEntry *) (p);
457 }
458
459
460
461 inline EXTERN Prop AbsOpProp (OpEntry * p);
462
463 inline EXTERN Prop
AbsOpProp(OpEntry * p)464 AbsOpProp (OpEntry * p)
465 {
466 return (Prop) (p);
467 }
468
469
470 #endif
471 #define OpProperty ((PropFlags)0xffff)
472
473
474 inline EXTERN PropFlags IsOpProperty (int);
475
476 inline EXTERN PropFlags
IsOpProperty(int flags)477 IsOpProperty (int flags)
478 {
479 return (PropFlags) ((flags == OpProperty));
480 }
481
482 typedef enum
483 {
484 INFIX_OP = 0,
485 POSFIX_OP = 1,
486 PREFIX_OP = 2
487 } op_type;
488
489
490 OpEntry *STD_PROTO(Yap_GetOpProp,(Atom, op_type));
491
492 int STD_PROTO(Yap_IsPrefixOp,(Atom,int *,int *));
493 int STD_PROTO(Yap_IsOp,(Atom));
494 int STD_PROTO(Yap_IsInfixOp,(Atom,int *,int *,int *));
495 int STD_PROTO(Yap_IsPosfixOp,(Atom,int *,int *));
496
497 /* defines related to operator specifications */
498 #define MaskPrio 0x0fff
499 #define DcrlpFlag 0x1000
500 #define DcrrpFlag 0x2000
501
502 typedef union arith_ret *eval_ret;
503
504 /* expression property entry structure */
505 typedef struct
506 {
507 Prop NextOfPE; /* used to chain properties */
508 PropFlags KindOfPE; /* kind of property */
509 unsigned int ArityOfEE;
510 BITS16 ENoOfEE;
511 BITS16 FlagsOfEE;
512 /* operations that implement the expression */
513 int FOfEE;
514 } ExpEntry;
515 #if USE_OFFSETS_IN_PROPS
516
517 inline EXTERN ExpEntry *RepExpProp (Prop p);
518
519 inline EXTERN ExpEntry *
RepExpProp(Prop p)520 RepExpProp (Prop p)
521 {
522 return (ExpEntry *) (AtomBase + Unsigned (p));
523 }
524
525
526
527 inline EXTERN Prop AbsExpProp (ExpEntry * p);
528
529 inline EXTERN Prop
AbsExpProp(ExpEntry * p)530 AbsExpProp (ExpEntry * p)
531 {
532 return (Prop) (Addr (p) - AtomBase);
533 }
534
535
536 #else
537
538 inline EXTERN ExpEntry *RepExpProp (Prop p);
539
540 inline EXTERN ExpEntry *
RepExpProp(Prop p)541 RepExpProp (Prop p)
542 {
543 return (ExpEntry *) (p);
544 }
545
546
547
548 inline EXTERN Prop AbsExpProp (ExpEntry * p);
549
550 inline EXTERN Prop
AbsExpProp(ExpEntry * p)551 AbsExpProp (ExpEntry * p)
552 {
553 return (Prop) (p);
554 }
555
556
557 #endif
558 #define ExpProperty 0xffe0
559
560 /* only unary and binary expressions are acceptable */
561
562 inline EXTERN PropFlags IsExpProperty (int);
563
564 inline EXTERN PropFlags
IsExpProperty(int flags)565 IsExpProperty (int flags)
566 {
567 return (PropFlags) ((flags == ExpProperty));
568 }
569
570
571
572
573 /* value property entry structure */
574 typedef struct
575 {
576 Prop NextOfPE; /* used to chain properties */
577 PropFlags KindOfPE; /* kind of property */
578 #if defined(YAPOR) || defined(THREADS)
579 rwlock_t VRWLock; /* a read-write lock to protect the entry */
580 #endif
581 Term ValueOfVE; /* (atomic) value associated with the atom */
582 } ValEntry;
583 #if USE_OFFSETS_IN_PROPS
584
585 inline EXTERN ValEntry *RepValProp (Prop p);
586
587 inline EXTERN ValEntry *
RepValProp(Prop p)588 RepValProp (Prop p)
589 {
590 return (ValEntry *) (AtomBase + Unsigned (p));
591 }
592
593
594
595 inline EXTERN Prop AbsValProp (ValEntry * p);
596
597 inline EXTERN Prop
AbsValProp(ValEntry * p)598 AbsValProp (ValEntry * p)
599 {
600 return (Prop) (Addr (p) - AtomBase);
601 }
602
603
604 #else
605
606 inline EXTERN ValEntry *RepValProp (Prop p);
607
608 inline EXTERN ValEntry *
RepValProp(Prop p)609 RepValProp (Prop p)
610 {
611 return (ValEntry *) (p);
612 }
613
614
615
616 inline EXTERN Prop AbsValProp (ValEntry * p);
617
618 inline EXTERN Prop
AbsValProp(ValEntry * p)619 AbsValProp (ValEntry * p)
620 {
621 return (Prop) (p);
622 }
623
624
625 #endif
626 #define ValProperty ((PropFlags)0xfffc)
627
628
629 inline EXTERN PropFlags IsValProperty (int);
630
631 inline EXTERN PropFlags
IsValProperty(int flags)632 IsValProperty (int flags)
633 {
634 return (PropFlags) ((flags == ValProperty));
635 }
636
637
638
639 /* predicate property entry structure */
640 /* AsmPreds are things like var, nonvar, atom ...which are implemented
641 through dedicated machine instructions. In this case the 8 lower
642 bits of PredFlags are used to hold the machine instruction code
643 for the pred.
644 C_Preds are things write, read, ... implemented in C. In this case
645 CodeOfPred holds the address of the correspondent C-function.
646 */
647 typedef enum
648 {
649 MegaClausePredFlag = 0x80000000L, /* predicate is implemented as a mega-clause */
650 ThreadLocalPredFlag = 0x40000000L, /* local to a thread */
651 MultiFileFlag = 0x20000000L, /* is multi-file */
652 UserCPredFlag = 0x10000000L, /* CPred defined by the user */
653 LogUpdatePredFlag = 0x08000000L, /* dynamic predicate with log. upd. sem. */
654 InUsePredFlag = 0x04000000L, /* count calls to pred */
655 CountPredFlag = 0x02000000L, /* count calls to pred */
656 HiddenPredFlag = 0x01000000L, /* invisible predicate */
657 CArgsPredFlag = 0x00800000L, /* SWI-like C-interface pred. */
658 SourcePredFlag = 0x00400000L, /* static predicate with source declaration */
659 MetaPredFlag = 0x00200000L, /* predicate subject to a meta declaration */
660 SyncPredFlag = 0x00100000L, /* has to synch before it can execute */
661 NumberDBPredFlag = 0x00080000L, /* entry for a number key */
662 AtomDBPredFlag = 0x00040000L, /* entry for an atom key */
663 GoalExPredFlag = 0x00020000L, /* predicate that is called by goal_expand */
664 TestPredFlag = 0x00010000L, /* is a test (optim. comit) */
665 AsmPredFlag = 0x00008000L, /* inline */
666 StandardPredFlag = 0x00004000L, /* system predicate */
667 DynamicPredFlag = 0x00002000L, /* dynamic predicate */
668 CPredFlag = 0x00001000L, /* written in C */
669 SafePredFlag = 0x00000800L, /* does not alter arguments */
670 CompiledPredFlag = 0x00000400L, /* is static */
671 IndexedPredFlag = 0x00000200L, /* has indexing code */
672 SpiedPredFlag = 0x00000100L, /* is a spy point */
673 BinaryPredFlag = 0x00000080L, /* test predicate */
674 TabledPredFlag = 0x00000040L, /* is tabled */
675 SequentialPredFlag = 0x00000020L, /* may not create parallel choice points! */
676 ProfiledPredFlag = 0x00000010L, /* pred is being profiled */
677 MyddasPredFlag = 0x00000008L, /* Myddas Imported pred */
678 ModuleTransparentPredFlag = 0x00000004L, /* ModuleTransparent pred */
679 SWIEnvPredFlag = 0x00000002L, /* new SWI interface */
680 UDIPredFlag = 0x00000001L /* User Defined Indexing */
681 } pred_flag;
682
683 /* profile data */
684 typedef struct
685 {
686 YAP_ULONG_LONG NOfEntries; /* nbr of times head unification succeeded */
687 YAP_ULONG_LONG NOfHeadSuccesses; /* nbr of times head unification succeeded */
688 YAP_ULONG_LONG NOfRetries; /* nbr of times a clause for the pred
689 was retried */
690 #if defined(YAPOR) || defined(THREADS)
691 lockvar lock; /* a simple lock to protect this entry */
692 #endif
693 } profile_data;
694
695 typedef enum {
696 LUCALL_EXEC,
697 LUCALL_ASSERT,
698 LUCALL_RETRACT
699 } timestamp_type;
700
701 #define TIMESTAMP_EOT ((UInt)(~0L))
702 #define TIMESTAMP_RESET (TIMESTAMP_EOT-1024)
703
704 typedef struct pred_entry
705 {
706 Prop NextOfPE; /* used to chain properties */
707 PropFlags KindOfPE; /* kind of property */
708 struct yami *CodeOfPred;
709 OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
710 CELL PredFlags;
711 unsigned int ArityOfPE; /* arity of property */
712 union
713 {
714 struct
715 {
716 struct yami *TrueCodeOfPred; /* code address */
717 struct yami *FirstClause;
718 struct yami *LastClause;
719 UInt NOfClauses;
720 OPCODE ExpandCode;
721 } p_code;
722 CPredicate f_code;
723 CmpPredicate d_code;
724 } cs; /* if needing to spy or to lock */
725 Functor FunctorOfPred; /* functor for Predicate */
726 union
727 {
728 Atom OwnerFile; /* File where the predicate was defined */
729 Int IndxId; /* Index for a certain key */
730 struct mfile *file_srcs; /* for multifile predicates */
731 } src;
732 #if defined(YAPOR) || defined(THREADS)
733 lockvar PELock; /* a simple lock to protect expansion */
734 #endif
735 #ifdef TABLING
736 tab_ent_ptr TableOfPred;
737 #endif /* TABLING */
738 #ifdef BEAM
739 struct Predicates *beamTable;
740 #endif
741 Term ModuleOfPred; /* module for this definition */
742 UInt TimeStampOfPred;
743 timestamp_type LastCallOfPred;
744 /* This must be at an odd number of cells, otherwise it
745 will not be aligned on RISC machines */
746 profile_data StatisticsForPred; /* enable profiling for predicate */
747 struct pred_entry *NextPredOfModule; /* next pred for same module */
748 } PredEntry;
749 #define PEProp ((PropFlags)(0x0000))
750
751 #if USE_OFFSETS_IN_PROPS
752
753 inline EXTERN PredEntry *RepPredProp (Prop p);
754
755 inline EXTERN PredEntry *
RepPredProp(Prop p)756 RepPredProp (Prop p)
757 {
758 return (PredEntry *) (AtomBase + Unsigned (p));
759 }
760
761
762
763 inline EXTERN Prop AbsPredProp (PredEntry * p);
764
765 inline EXTERN Prop
AbsPredProp(PredEntry * p)766 AbsPredProp (PredEntry * p)
767 {
768 return (Prop) (Addr (p) - AtomBase);
769 }
770
771
772 #else
773
774 inline EXTERN PredEntry *RepPredProp (Prop p);
775
776 inline EXTERN PredEntry *
RepPredProp(Prop p)777 RepPredProp (Prop p)
778 {
779 return (PredEntry *) (p);
780 }
781
782
783
784 inline EXTERN Prop AbsPredProp (PredEntry * p);
785
786 inline EXTERN Prop
AbsPredProp(PredEntry * p)787 AbsPredProp (PredEntry * p)
788 {
789 return (Prop) (p);
790 }
791
792
793 #endif
794
795
796 inline EXTERN PropFlags IsPredProperty (int);
797
798 inline EXTERN PropFlags
IsPredProperty(int flags)799 IsPredProperty (int flags)
800 {
801 return (PropFlags) ((flags == PEProp));
802 }
803
804
805
806 /* Flags for code or dbase entry */
807 /* There are several flags for code and data base entries */
808 typedef enum
809 {
810 FuncSwitchMask = 0x800000, /* is a switch of functors */
811 HasDBTMask = 0x400000, /* includes a pointer to a DBTerm */
812 MegaMask = 0x200000, /* mega clause */
813 FactMask = 0x100000, /* a fact */
814 SwitchRootMask = 0x80000, /* root for the index tree */
815 SwitchTableMask = 0x40000, /* switch table */
816 HasBlobsMask = 0x20000, /* blobs which may be in use */
817 ProfFoundMask = 0x10000, /* clause is being counted by profiler */
818 DynamicMask = 0x8000, /* dynamic predicate */
819 InUseMask = 0x4000, /* this block is being used */
820 ErasedMask = 0x2000, /* this block has been erased */
821 IndexMask = 0x1000, /* indexing code */
822 DBClMask = 0x0800, /* data base structure */
823 LogUpdRuleMask = 0x0400, /* code is for a log upd rule with env */
824 LogUpdMask = 0x0200, /* logic update index. */
825 StaticMask = 0x0100, /* static predicates */
826 DirtyMask = 0x0080 /* LUIndices */
827 /* other flags belong to DB */
828 } dbentry_flags;
829
830 /* *********************** DBrefs **************************************/
831
832 typedef struct DB_TERM
833 {
834 #ifdef COROUTINING
835 union {
836 CELL attachments; /* attached terms */
837 struct DB_TERM *NextDBT;
838 } ag;
839 #endif
840 struct DB_STRUCT **DBRefs; /* pointer to other references */
841 CELL NOfCells; /* Size of Term */
842 CELL Entry; /* entry point */
843 Term Contents[MIN_ARRAY]; /* stored term */
844 } DBTerm;
845
846 inline EXTERN DBTerm *TermToDBTerm(Term);
847
TermToDBTerm(Term X)848 inline EXTERN DBTerm *TermToDBTerm(Term X)
849 {
850 if (IsPairTerm(X)) {
851 return(DBTerm *)((char *)RepPair(X) - (CELL) &(((DBTerm *) NULL)->Contents));
852 } else {
853 return(DBTerm *)((char *)RepAppl(X) - (CELL) &(((DBTerm *) NULL)->Contents));
854 }
855 }
856
857
858 /* The ordering of the first 3 fields should be compatible with lu_clauses */
859 typedef struct DB_STRUCT
860 {
861 Functor id; /* allow pointers to this struct to id */
862 /* as dbref */
863 CELL Flags; /* Term Flags */
864 #if defined(YAPOR) || defined(THREADS)
865 lockvar lock; /* a simple lock to protect this entry */
866 Int ref_count; /* how many branches are using this entry */
867 #endif
868 CELL NOfRefsTo; /* Number of references pointing here */
869 struct struct_dbentry *Parent; /* key of DBase reference */
870 struct yami *Code; /* pointer to code if this is a clause */
871 struct DB_STRUCT *Prev; /* Previous element in chain */
872 struct DB_STRUCT *Next; /* Next element in chain */
873 struct DB_STRUCT *p, *n; /* entry's age, negative if from recorda,
874 positive if it was recordz */
875 CELL Mask; /* parts that should be cleared */
876 CELL Key; /* A mask that can be used to check before
877 you unify */
878 DBTerm DBT;
879 } DBStruct;
880
881 #define DBStructFlagsToDBStruct(X) ((DBRef)((char *)(X) - (CELL) &(((DBRef) NULL)->Flags)))
882
883 #if defined(YAPOR) || defined(THREADS)
884 #define INIT_DBREF_COUNT(X) (X)->ref_count = 0
885 #define INC_DBREF_COUNT(X) (X)->ref_count++
886 #define DEC_DBREF_COUNT(X) (X)->ref_count--
887 #define DBREF_IN_USE(X) ((X)->ref_count != 0)
888 #else
889 #define INIT_DBREF_COUNT(X)
890 #define INC_DBREF_COUNT(X)
891 #define DEC_DBREF_COUNT(X)
892 #define DBREF_IN_USE(X) ((X)->Flags & InUseMask)
893 #endif
894
895 typedef DBStruct *DBRef;
896
897 /* extern Functor FunctorDBRef; */
898
899 inline EXTERN int IsDBRefTerm (Term);
900
901 inline EXTERN int
IsDBRefTerm(Term t)902 IsDBRefTerm (Term t)
903 {
904 return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDBRef);
905 }
906
907
908
909 inline EXTERN Term MkDBRefTerm (DBRef);
910
911 inline EXTERN Term
MkDBRefTerm(DBRef p)912 MkDBRefTerm (DBRef p)
913 {
914 return (Term) ((AbsAppl (((CELL *) (p)))));
915 }
916
917
918
919 inline EXTERN DBRef DBRefOfTerm (Term t);
920
921 inline EXTERN DBRef
DBRefOfTerm(Term t)922 DBRefOfTerm (Term t)
923 {
924 return (DBRef) (((DBRef) (RepAppl (t))));
925 }
926
927
928
929
930 inline EXTERN int IsRefTerm (Term);
931
932 inline EXTERN int
IsRefTerm(Term t)933 IsRefTerm (Term t)
934 {
935 return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDBRef);
936 }
937
938
939
940 inline EXTERN CODEADDR RefOfTerm (Term t);
941
942 inline EXTERN CODEADDR
RefOfTerm(Term t)943 RefOfTerm (Term t)
944 {
945 return (CODEADDR) (DBRefOfTerm (t));
946 }
947
948
949
950 typedef struct struct_dbentry
951 {
952 Prop NextOfPE; /* used to chain properties */
953 PropFlags KindOfPE; /* kind of property */
954 unsigned int ArityOfDB; /* kind of property */
955 Functor FunctorOfDB; /* functor for this property */
956 #if defined(YAPOR) || defined(THREADS)
957 rwlock_t DBRWLock; /* a simple lock to protect this entry */
958 #endif
959 DBRef First; /* first DBase entry */
960 DBRef Last; /* last DBase entry */
961 Term ModuleOfDB; /* module for this definition */
962 DBRef F0, L0; /* everyone */
963 } DBEntry;
964 typedef DBEntry *DBProp;
965 #define DBProperty ((PropFlags)0x8000)
966
967 typedef struct
968 {
969 Prop NextOfPE; /* used to chain properties */
970 PropFlags KindOfPE; /* kind of property */
971 unsigned int ArityOfDB; /* kind of property */
972 Functor FunctorOfDB; /* functor for this property */
973 #if defined(YAPOR) || defined(THREADS)
974 rwlock_t DBRWLock; /* a simple lock to protect this entry */
975 #endif
976 DBRef First; /* first DBase entry */
977 DBRef Last; /* last DBase entry */
978 Term ModuleOfDB; /* module for this definition */
979 Int NOfEntries; /* age counter */
980 DBRef Index; /* age counter */
981 } LogUpdDBEntry;
982 typedef LogUpdDBEntry *LogUpdDBProp;
983 #define CodeDBBit 0x2
984
985 #define CodeDBProperty (DBProperty|CodeDBBit)
986
987
988 inline EXTERN PropFlags IsDBProperty (int);
989
990 inline EXTERN PropFlags
IsDBProperty(int flags)991 IsDBProperty (int flags)
992 {
993 return (PropFlags) ((flags & ~CodeDBBit) == DBProperty);
994 }
995
996
997
998 #if USE_OFFSETS_IN_PROPS
999
1000 inline EXTERN DBProp RepDBProp (Prop p);
1001
1002 inline EXTERN DBProp
RepDBProp(Prop p)1003 RepDBProp (Prop p)
1004 {
1005 return (DBProp) (AtomBase + Unsigned (p));
1006 }
1007
1008
1009
1010 inline EXTERN Prop AbsDBProp (DBProp p);
1011
1012 inline EXTERN Prop
AbsDBProp(DBProp p)1013 AbsDBProp (DBProp p)
1014 {
1015 return (Prop) (Addr (p) - AtomBase);
1016 }
1017
1018
1019 #else
1020
1021 inline EXTERN DBProp RepDBProp (Prop p);
1022
1023 inline EXTERN DBProp
RepDBProp(Prop p)1024 RepDBProp (Prop p)
1025 {
1026 return (DBProp) (p);
1027 }
1028
1029
1030
1031 inline EXTERN Prop AbsDBProp (DBProp p);
1032
1033 inline EXTERN Prop
AbsDBProp(DBProp p)1034 AbsDBProp (DBProp p)
1035 {
1036 return (Prop) (p);
1037 }
1038
1039
1040 #endif
1041
1042
1043 /* These are the actual flags for DataBase terms */
1044 typedef enum
1045 {
1046 DBAtomic = 0x1,
1047 DBVar = 0x2,
1048 DBNoVars = 0x4,
1049 DBComplex = 0x8,
1050 DBCode = 0x10,
1051 DBNoCode = 0x20,
1052 DBWithRefs = 0x40
1053 } db_term_flags;
1054
1055 typedef struct
1056 {
1057 Prop NextOfPE; /* used to chain properties */
1058 PropFlags KindOfPE; /* kind of property */
1059 Atom KeyOfBB; /* functor for this property */
1060 Term Element; /* blackboard element */
1061 #if defined(YAPOR) || defined(THREADS)
1062 rwlock_t BBRWLock; /* a read-write lock to protect the entry */
1063 #endif
1064 Term ModuleOfBB; /* module for this definition */
1065 } BlackBoardEntry;
1066 typedef BlackBoardEntry *BBProp;
1067
1068 #if USE_OFFSETS_IN_PROPS
1069
1070 inline EXTERN BlackBoardEntry *RepBBProp (Prop p);
1071
1072 inline EXTERN BlackBoardEntry *
RepBBProp(Prop p)1073 RepBBProp (Prop p)
1074 {
1075 return (BlackBoardEntry *) (AtomBase + Unsigned (p));
1076 }
1077
1078
1079
1080 inline EXTERN Prop AbsBBProp (BlackBoardEntry * p);
1081
1082 inline EXTERN Prop
AbsBBProp(BlackBoardEntry * p)1083 AbsBBProp (BlackBoardEntry * p)
1084 {
1085 return (Prop) (Addr (p) - AtomBase);
1086 }
1087
1088
1089 #else
1090
1091 inline EXTERN BlackBoardEntry *RepBBProp (Prop p);
1092
1093 inline EXTERN BlackBoardEntry *
RepBBProp(Prop p)1094 RepBBProp (Prop p)
1095 {
1096 return (BlackBoardEntry *) (p);
1097 }
1098
1099
1100
1101 inline EXTERN Prop AbsBBProp (BlackBoardEntry * p);
1102
1103 inline EXTERN Prop
AbsBBProp(BlackBoardEntry * p)1104 AbsBBProp (BlackBoardEntry * p)
1105 {
1106 return (Prop) (p);
1107 }
1108
1109
1110 #endif
1111
1112 #define BBProperty ((PropFlags)0xfffb)
1113
1114
1115 inline EXTERN PropFlags IsBBProperty (int);
1116
1117 inline EXTERN PropFlags
IsBBProperty(int flags)1118 IsBBProperty (int flags)
1119 {
1120 return (PropFlags) ((flags == BBProperty));
1121 }
1122
1123
1124 /* hold property entry structure */
1125 typedef struct hold_entry
1126 {
1127 Prop NextOfPE; /* used to chain properties */
1128 PropFlags KindOfPE; /* kind of property */
1129 UInt RefsOfPE; /* used to count the number of holds */
1130 } HoldEntry;
1131
1132 #if USE_OFFSETS_IN_PROPS
1133
1134 inline EXTERN HoldEntry *RepHoldProp (Prop p);
1135
1136 inline EXTERN HoldEntry *
RepHoldProp(Prop p)1137 RepHoldProp (Prop p)
1138 {
1139 return (HoldEntry *) (AtomBase + Unsigned (p));
1140 }
1141
1142
1143
1144 inline EXTERN Prop AbsHoldProp (HoldEntry * p);
1145
1146 inline EXTERN Prop
AbsHoldProp(HoldEntry * p)1147 AbsHoldProp (HoldEntry * p)
1148 {
1149 return (Prop) (Addr (p) - AtomBase);
1150 }
1151
1152
1153 #else
1154
1155 inline EXTERN HoldEntry *RepHoldProp (Prop p);
1156
1157 inline EXTERN HoldEntry *
RepHoldProp(Prop p)1158 RepHoldProp (Prop p)
1159 {
1160 return (HoldEntry *) (p);
1161 }
1162
1163
1164
1165 inline EXTERN Prop AbsHoldProp (HoldEntry * p);
1166
1167 inline EXTERN Prop
AbsHoldProp(HoldEntry * p)1168 AbsHoldProp (HoldEntry * p)
1169 {
1170 return (Prop) (p);
1171 }
1172
1173
1174 #endif
1175 #define HoldProperty 0xfff6
1176
1177 /* only unary and binary expressions are acceptable */
1178
1179 inline EXTERN PropFlags IsHoldProperty (int);
1180
1181 inline EXTERN PropFlags
IsHoldProperty(int flags)1182 IsHoldProperty (int flags)
1183 {
1184 return (PropFlags) ((flags == HoldProperty));
1185 }
1186
1187
1188
1189
1190 /* array property entry structure */
1191 /* first case is for dynamic arrays */
1192 typedef struct array_entry
1193 {
1194 Prop NextOfPE; /* used to chain properties */
1195 PropFlags KindOfPE; /* kind of property */
1196 Int ArrayEArity; /* Arity of Array (positive) */
1197 #if defined(YAPOR) || defined(THREADS)
1198 rwlock_t ArRWLock; /* a read-write lock to protect the entry */
1199 #if THREADS
1200 unsigned int owner_id;
1201 #endif
1202 #endif
1203 struct array_entry *NextAE;
1204 Term ValueOfVE; /* Pointer to the actual array */
1205 } ArrayEntry;
1206
1207 /* second case is for static arrays */
1208
1209 /* first, the valid types */
1210 typedef enum
1211 {
1212 array_of_ints,
1213 array_of_chars,
1214 array_of_uchars,
1215 array_of_doubles,
1216 array_of_ptrs,
1217 array_of_atoms,
1218 array_of_dbrefs,
1219 array_of_nb_terms,
1220 array_of_terms
1221 } static_array_types;
1222
1223 typedef struct {
1224 Term tlive;
1225 Term tstore;
1226 } live_term;
1227
1228
1229 typedef union
1230 {
1231 Int *ints;
1232 char *chars;
1233 unsigned char *uchars;
1234 Float *floats;
1235 AtomEntry **ptrs;
1236 Term *atoms;
1237 Term *dbrefs;
1238 DBTerm **terms;
1239 live_term *lterms;
1240 } statarray_elements;
1241
1242 /* next, the actual data structure */
1243 typedef struct static_array_entry
1244 {
1245 Prop NextOfPE; /* used to chain properties */
1246 PropFlags KindOfPE; /* kind of property */
1247 Int ArrayEArity; /* Arity of Array (negative) */
1248 #if defined(YAPOR) || defined(THREADS)
1249 rwlock_t ArRWLock; /* a read-write lock to protect the entry */
1250 #endif
1251 struct static_array_entry *NextAE;
1252 static_array_types ArrayType; /* Type of Array Elements. */
1253 statarray_elements ValueOfVE; /* Pointer to the Array itself */
1254 } StaticArrayEntry;
1255
1256
1257 #if USE_OFFSETS_IN_PROPS
1258
1259 inline EXTERN ArrayEntry *RepArrayProp (Prop p);
1260
1261 inline EXTERN ArrayEntry *
RepArrayProp(Prop p)1262 RepArrayProp (Prop p)
1263 {
1264 return (ArrayEntry *) (AtomBase + Unsigned (p));
1265 }
1266
1267
1268
1269 inline EXTERN Prop AbsArrayProp (ArrayEntry * p);
1270
1271 inline EXTERN Prop
AbsArrayProp(ArrayEntry * p)1272 AbsArrayProp (ArrayEntry * p)
1273 {
1274 return (Prop) (Addr (p) - AtomBase);
1275 }
1276
1277
1278
1279 inline EXTERN StaticArrayEntry *RepStaticArrayProp (Prop p);
1280
1281 inline EXTERN StaticArrayEntry *
RepStaticArrayProp(Prop p)1282 RepStaticArrayProp (Prop p)
1283 {
1284 return (StaticArrayEntry *) (AtomBase + Unsigned (p));
1285 }
1286
1287
1288
1289 inline EXTERN Prop AbsStaticArrayProp (StaticArrayEntry * p);
1290
1291 inline EXTERN Prop
AbsStaticArrayProp(StaticArrayEntry * p)1292 AbsStaticArrayProp (StaticArrayEntry * p)
1293 {
1294 return (Prop) (Addr (p) - AtomBase);
1295 }
1296
1297
1298 #else
1299
1300 inline EXTERN ArrayEntry *RepArrayProp (Prop p);
1301
1302 inline EXTERN ArrayEntry *
RepArrayProp(Prop p)1303 RepArrayProp (Prop p)
1304 {
1305 return (ArrayEntry *) (p);
1306 }
1307
1308
1309
1310 inline EXTERN Prop AbsArrayProp (ArrayEntry * p);
1311
1312 inline EXTERN Prop
AbsArrayProp(ArrayEntry * p)1313 AbsArrayProp (ArrayEntry * p)
1314 {
1315 return (Prop) (p);
1316 }
1317
1318
1319
1320 inline EXTERN StaticArrayEntry *RepStaticArrayProp (Prop p);
1321
1322 inline EXTERN StaticArrayEntry *
RepStaticArrayProp(Prop p)1323 RepStaticArrayProp (Prop p)
1324 {
1325 return (StaticArrayEntry *) (p);
1326 }
1327
1328
1329
1330 inline EXTERN Prop AbsStaticArrayProp (StaticArrayEntry * p);
1331
1332 inline EXTERN Prop
AbsStaticArrayProp(StaticArrayEntry * p)1333 AbsStaticArrayProp (StaticArrayEntry * p)
1334 {
1335 return (Prop) (p);
1336 }
1337
1338
1339 #endif
1340 #define ArrayProperty ((PropFlags)0xfff7)
1341
1342
1343 inline EXTERN int ArrayIsDynamic (ArrayEntry *);
1344
1345 inline EXTERN int
ArrayIsDynamic(ArrayEntry * are)1346 ArrayIsDynamic (ArrayEntry * are)
1347 {
1348 return (int) (((are)->ArrayEArity > 0));
1349 }
1350
1351
1352
1353
1354 inline EXTERN PropFlags IsArrayProperty (int);
1355
1356 inline EXTERN PropFlags
IsArrayProperty(int flags)1357 IsArrayProperty (int flags)
1358 {
1359 return (PropFlags) ((flags == ArrayProperty));
1360 }
1361
1362
1363
1364 /* SWI Blob property */
1365 typedef struct blob_atom_entry
1366 {
1367 Prop NextOfPE; /* used to chain properties */
1368 PropFlags KindOfPE; /* kind of property */
1369 struct PL_blob_t *blob_t; /* type of blob */
1370 } BlobPropEntry;
1371
1372 #if USE_OFFSETS_IN_PROPS
1373
1374 inline EXTERN BlobAtomEntry *RepBlobProp (Prop p);
1375
1376 inline EXTERN BlobPropEntry *
RepBlobProp(Prop p)1377 RepBlobProp (Prop p)
1378 {
1379 return (BlobPropEntry *) (AtomBase + Unsigned (p));
1380 }
1381
1382
1383
1384 inline EXTERN AtomEntry *AbsBlobProp (BlobPropEntry * p);
1385
1386 inline EXTERN Prop
AbsBlobProp(BlobPropEntry * p)1387 AbsBlobProp (BlobPropEntry * p)
1388 {
1389 return (Prop) (Addr (p) - AtomBase);
1390 }
1391
1392
1393 #else
1394
1395 inline EXTERN BlobPropEntry *RepBlobProp (Prop p);
1396
1397 inline EXTERN BlobPropEntry *
RepBlobProp(Prop p)1398 RepBlobProp (Prop p)
1399 {
1400 return (BlobPropEntry *) (p);
1401 }
1402
1403
1404
1405 inline EXTERN Prop AbsBlobProp (BlobPropEntry * p);
1406
1407 inline EXTERN Prop
AbsBlobProp(BlobPropEntry * p)1408 AbsBlobProp (BlobPropEntry * p)
1409 {
1410 return (Prop) (p);
1411 }
1412
1413
1414 #endif
1415
1416 #define BlobProperty ((PropFlags)0xfff5)
1417
1418
1419 inline EXTERN PropFlags IsBlobProperty (int);
1420
1421 inline EXTERN PropFlags
IsBlobProperty(int flags)1422 IsBlobProperty (int flags)
1423 {
1424 return (PropFlags) ((flags == BlobProperty));
1425 }
1426
1427 inline EXTERN int IsBlob (Atom);
1428
1429 inline EXTERN int
IsBlob(Atom at)1430 IsBlob (Atom at)
1431 {
1432 return RepAtom(at)->PropsOfAE &&
1433 IsBlobProperty(RepBlobProp(RepAtom(at)->PropsOfAE)->KindOfPE);
1434 }
1435
1436
1437 /* Proto types */
1438
1439 /* cdmgr.c */
1440 int STD_PROTO (Yap_RemoveIndexation, (PredEntry *));
1441 void STD_PROTO (Yap_UpdateTimestamps, (PredEntry *));
1442
1443 /* dbase.c */
1444 void STD_PROTO (Yap_ErDBE, (DBRef));
1445 DBTerm *STD_PROTO (Yap_StoreTermInDB, (Term, int));
1446 DBTerm *STD_PROTO (Yap_StoreTermInDBPlusExtraSpace, (Term, UInt, UInt *));
1447 Term STD_PROTO (Yap_FetchTermFromDB, (DBTerm *));
1448 Term STD_PROTO (Yap_PopTermFromDB, (DBTerm *));
1449 void STD_PROTO (Yap_ReleaseTermFromDB, (DBTerm *));
1450
1451 /* init.c */
1452 Atom STD_PROTO (Yap_GetOp, (OpEntry *, int *, int));
1453
1454 /* vsc: redefined to GetAProp to avoid conflicts with Windows header files */
1455 Prop STD_PROTO (Yap_GetAProp, (Atom, PropFlags));
1456 Prop STD_PROTO (Yap_GetAPropHavingLock, (AtomEntry *, PropFlags));
1457
1458 typedef enum
1459 {
1460 PROLOG_MODULE = 0,
1461 USER_MODULE = 1,
1462 IDB_MODULE = 2,
1463 ATTRIBUTES_MODULE = 3,
1464 CHARSIO_MODULE = 4,
1465 TERMS_MODULE = 5
1466 } default_modules;
1467
1468 #include "YapHeap.h"
1469
1470 #define PredHashInitialSize ((UInt)1039)
1471 #define PredHashIncrement ((UInt)7919)
1472
1473 EXTERN inline UInt STD_PROTO(PRED_HASH, (FunctorEntry *, Term, UInt));
1474
1475 EXTERN inline UInt
PRED_HASH(FunctorEntry * fe,Term cur_mod,UInt size)1476 PRED_HASH(FunctorEntry *fe, Term cur_mod, UInt size)
1477 {
1478 return (((CELL)fe+cur_mod)>>2) % size;
1479 }
1480
1481 EXTERN inline Prop STD_PROTO(GetPredPropByFuncHavingLock, (FunctorEntry *, Term));
1482
1483 #ifdef THREADS
1484
1485 Prop STD_PROTO(Yap_NewThreadPred, (struct pred_entry *));
1486 Prop STD_PROTO(Yap_NewPredPropByFunctor, (Functor, Term));
1487 EXTERN inline struct pred_entry *STD_PROTO(Yap_GetThreadPred, (struct pred_entry *));
1488
1489 EXTERN inline struct pred_entry *
Yap_GetThreadPred(struct pred_entry * ap)1490 Yap_GetThreadPred(struct pred_entry *ap)
1491 {
1492 Functor f = ap->FunctorOfPred;
1493 Term mod = ap->ModuleOfPred;
1494 Prop p0 = AbsPredProp(MY_ThreadHandle.local_preds);
1495
1496 while(p0) {
1497 PredEntry *ap = RepPredProp(p0);
1498 if (ap->FunctorOfPred == f &&
1499 ap->ModuleOfPred == mod) return ap;
1500 p0 = ap->NextOfPE;
1501 }
1502 return RepPredProp(Yap_NewThreadPred(ap));
1503 }
1504 #endif
1505
1506
1507 EXTERN inline Prop
GetPredPropByFuncHavingLock(FunctorEntry * fe,Term cur_mod)1508 GetPredPropByFuncHavingLock (FunctorEntry *fe, Term cur_mod)
1509 {
1510 PredEntry *p;
1511
1512 if (!(p = RepPredProp(fe->PropsOfFE))) {
1513 return NIL;
1514 }
1515 if ((p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
1516 #ifdef THREADS
1517 /* Thread Local Predicates */
1518 if (p->PredFlags & ThreadLocalPredFlag) {
1519 return AbsPredProp (Yap_GetThreadPred (p));
1520 }
1521 #endif
1522 return AbsPredProp(p);
1523 }
1524 if (p->NextOfPE) {
1525 UInt hash = PRED_HASH(fe,cur_mod,PredHashTableSize);
1526 READ_LOCK(PredHashRWLock);
1527 p = PredHash[hash];
1528
1529 while (p) {
1530 if (p->FunctorOfPred == fe &&
1531 p->ModuleOfPred == cur_mod)
1532 {
1533 #ifdef THREADS
1534 /* Thread Local Predicates */
1535 if (p->PredFlags & ThreadLocalPredFlag) {
1536 READ_UNLOCK(PredHashRWLock);
1537 return AbsPredProp (Yap_GetThreadPred (p));
1538 }
1539 #endif
1540 READ_UNLOCK(PredHashRWLock);
1541 return AbsPredProp(p);
1542 }
1543 p = RepPredProp(p->NextOfPE);
1544 }
1545 READ_UNLOCK(PredHashRWLock);
1546 }
1547 return NIL;
1548 }
1549
1550 EXTERN inline Prop
PredPropByFunc(Functor fe,Term cur_mod)1551 PredPropByFunc (Functor fe, Term cur_mod)
1552 /* get predicate entry for ap/arity; create it if neccessary. */
1553 {
1554 Prop p0;
1555
1556 WRITE_LOCK (fe->FRWLock);
1557 p0 = GetPredPropByFuncHavingLock(fe, cur_mod);
1558 if (p0) {
1559 WRITE_UNLOCK (fe->FRWLock);
1560 return p0;
1561 }
1562 return Yap_NewPredPropByFunctor (fe, cur_mod);
1563 }
1564
1565 EXTERN inline Prop
PredPropByAtom(Atom at,Term cur_mod)1566 PredPropByAtom (Atom at, Term cur_mod)
1567 /* get predicate entry for ap/arity; create it if neccessary. */
1568 {
1569 Prop p0;
1570 AtomEntry *ae = RepAtom (at);
1571
1572 WRITE_LOCK (ae->ARWLock);
1573 p0 = ae->PropsOfAE;
1574 while (p0)
1575 {
1576 PredEntry *pe = RepPredProp (p0);
1577 if (pe->KindOfPE == PEProp &&
1578 (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred))
1579 {
1580 #ifdef THREADS
1581 /* Thread Local Predicates */
1582 if (pe->PredFlags & ThreadLocalPredFlag)
1583 {
1584 WRITE_UNLOCK (ae->ARWLock);
1585 return AbsPredProp (Yap_GetThreadPred (pe));
1586 }
1587 #endif
1588 WRITE_UNLOCK (ae->ARWLock);
1589 return (p0);
1590 }
1591 p0 = pe->NextOfPE;
1592 }
1593 return Yap_NewPredPropByAtom (ae, cur_mod);
1594 }
1595
1596 #if DEBUG_PELOCKING
1597 #define PELOCK(I,Z) \
1598 { LOCK((Z)->PELock); (Z)->StatisticsForPred.NOfEntries=(I);(Z)->StatisticsForPred.NOfHeadSuccesses=pthread_self(); }
1599 #define UNLOCKPE(I,Z) \
1600 ( (Z)->StatisticsForPred.NOfRetries=(I), UNLOCK((Z)->PELock) )
1601 #else
1602 #define PELOCK(I,Z) LOCK((Z)->PELock)
1603 #define UNLOCKPE(I,Z) UNLOCK((Z)->PELock)
1604 #endif
1605
1606 #endif
1607
1608