YAP 7.1.0
bb.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: bb.c *
12* Last rev: 12/29/99 *
13* mods: *
140* comments: YAP's blackboard routines *
15* *
16*************************************************************************/
17
18#ifdef SCCS
19static char SccsId[] = "%W% %G%";
20#endif
21
22
42#include "Yap.h"
43
44#include "YapError.h"
45
46#include "clause.h"
47#ifndef NULL
48#define NULL (void *)0
49#endif
50
51static BBProp
52PutBBProp(AtomEntry *ae, Term mod USES_REGS) /* get BBentry for at; */
53{
54 Prop p0;
55 BBProp p;
56
57 WRITE_LOCK(ae->ARWLock);
58 p = RepBBProp(p0 = ae->PropsOfAE);
59 while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
60 (p->ModuleOfBB != mod))) {
61 p = RepBBProp(p0 = p->NextOfPE);
62 }
63 if (p0 == NIL) {
64 p = (BBProp)Yap_AllocAtomSpace(sizeof(*p));
65 if (p == NULL) {
66 WRITE_UNLOCK(ae->ARWLock);
67 Yap_Error(RESOURCE_ERROR_HEAP,ARG1,"could not allocate space in bb_put/2");
68 return(NULL);
69 }
70 AddPropToAtom(ae, (PropEntry *)p);
71 p->ModuleOfBB = mod;
72 p->Element = 0L;
73 p->KeyOfBB = AbsAtom(ae);
74 p->KindOfPE = BBProperty;
75 INIT_RWLOCK(p->BBRWLock);
76 }
77 WRITE_UNLOCK(ae->ARWLock);
78 return (p);
79}
80
81static BBProp
82PutIntBBProp(Int key, Term mod USES_REGS) /* get BBentry for at; */
83{
84 Prop p0;
85 BBProp p;
86 UInt hash_key;
87
88 if (INT_BB_KEYS == NULL) {
89 INT_BB_KEYS = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*INT_BB_KEYS_SIZE);
90 if (INT_BB_KEYS != NULL) {
91 UInt i = 0;
92 Prop *pp = INT_BB_KEYS;
93 for (i = 0; i < INT_BB_KEYS_SIZE; i++) {
94 pp[0] = NIL;
95 pp++;
96 }
97 } else {
98 Yap_Error(RESOURCE_ERROR_HEAP,ARG1,"could not allocate space in bb_put/2");
99 return(NULL);
100 }
101 }
102 hash_key = (CELL)key % INT_BB_KEYS_SIZE;
103 p0 = INT_BB_KEYS[hash_key];
104 p = RepBBProp(p0);
105 while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
106 key != (Int)(p->KeyOfBB) ||
107 (p->ModuleOfBB != mod))) {
108 p = RepBBProp(p0 = p->NextOfPE);
109 }
110 if (p0 == NIL) {
111 YAPEnterCriticalSection();
112 p = (BBProp)Yap_AllocAtomSpace(sizeof(*p));
113 if (p == NULL) {
114 YAPLeaveCriticalSection();
115 Yap_Error(RESOURCE_ERROR_HEAP,ARG1,"could not allocate space in bb_put/2");
116 return(NULL);
117 }
118 p->ModuleOfBB = mod;
119 p->Element = 0L;
120 p->KeyOfBB = (Atom)key;
121 p->KindOfPE = BBProperty;
122 p->NextOfPE = INT_BB_KEYS[hash_key];
123 INT_BB_KEYS[hash_key] = AbsBBProp(p);
124 YAPLeaveCriticalSection();
125 }
126 return (p);
127}
128
129static BBProp
130GetBBProp(AtomEntry *ae, Term mod) /* get BBentry for at; */
131{
132 Prop p0;
133 BBProp p;
134
135 READ_LOCK(ae->ARWLock);
136 p = RepBBProp(p0 = ae->PropsOfAE);
137 while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
138 (p->ModuleOfBB != mod))) {
139 p = RepBBProp(p0 = p->NextOfPE);
140 }
141 READ_UNLOCK(ae->ARWLock);
142 if (p0 == NIL) {
143 return(NULL);
144 }
145 return (p);
146}
147
148static BBProp
149GetIntBBProp(Int key, Term mod) /* get BBentry for at; */
150{
151 Prop p0;
152 BBProp p;
153 UInt hash_key;
154
155 if (INT_BB_KEYS == NULL)
156 return(NULL);
157 hash_key = (CELL)key % INT_BB_KEYS_SIZE;
158 p0 = INT_BB_KEYS[hash_key];
159 p = RepBBProp(p0);
160 while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
161 key != (Int)(p->KeyOfBB) ||
162 (p->ModuleOfBB != mod))) {
163 p = RepBBProp(p0 = p->NextOfPE);
164 }
165 if (p0 == NIL) {
166 return(NULL);
167 }
168 return (p);
169}
170
171static int
172resize_bb_int_keys(UInt new_size) {
173 CACHE_REGS
174 Prop *new;
175 UInt i;
176
177 YAPEnterCriticalSection();
178 if (INT_BB_KEYS == NULL) {
179 INT_BB_KEYS_SIZE = new_size;
180 YAPLeaveCriticalSection();
181 return(TRUE);
182 }
183 new = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*new_size);
184 if (new == NULL) {
185 YAPLeaveCriticalSection();
186 Yap_Error(RESOURCE_ERROR_HEAP,ARG1,"could not allocate space");
187 return(FALSE);
188 }
189 for (i = 0; i < new_size; i++) {
190 new[i] = NIL;
191 }
192 for (i = 0; i < INT_BB_KEYS_SIZE; i++) {
193 if (INT_BB_KEYS[i] != NIL) {
194 Prop p0 = INT_BB_KEYS[i];
195 while (p0 != NIL) {
196 BBProp p = RepBBProp(p0);
197 CELL key = (CELL)(p->KeyOfBB);
198 UInt hash_key = (CELL)key % new_size;
199 p0 = p->NextOfPE;
200 p->NextOfPE = new[hash_key];
201 new[hash_key] = AbsBBProp(p);
202 }
203 }
204 }
205 Yap_FreeCodeSpace((char *)INT_BB_KEYS);
206 INT_BB_KEYS = new;
207 INT_BB_KEYS_SIZE = new_size;
208 YAPLeaveCriticalSection();
209 return(TRUE);
210}
211
212static BBProp
213AddBBProp(Term t1, char *msg, Term mod USES_REGS)
214{
215 BBProp p;
216
217 restart:
218 if (IsVarTerm(t1)) {
219 Yap_Error(INSTANTIATION_ERROR, t1, msg);
220 return(NULL);
221 } if (IsAtomTerm(t1)) {
222 p = PutBBProp(RepAtom(AtomOfTerm(t1)), mod PASS_REGS);
223 } else if (IsIntegerTerm(t1)) {
224 p = PutIntBBProp(IntegerOfTerm(t1), mod PASS_REGS);
225 } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
226 Term tmod = ArgOfTerm(1, t1);
227 if (!IsVarTerm(tmod) ) {
228 t1 = ArgOfTerm(2, t1);
229 mod = tmod;
230 goto restart;
231 } else {
232 Yap_Error(INSTANTIATION_ERROR, t1, msg);
233 return(NULL);
234 }
235 } else {
236 Yap_Error(TYPE_ERROR_ATOM, t1, msg);
237 return(NULL);
238 }
239 return(p);
240}
241
242static BBProp
243FetchBBProp(Term t1, char *msg, Term mod)
244{
245 BBProp p;
246
247 restart:
248 if (IsVarTerm(t1)) {
249 Yap_Error(INSTANTIATION_ERROR, t1, msg);
250 return(NULL);
251 } if (IsAtomTerm(t1)) {
252 p = GetBBProp(RepAtom(AtomOfTerm(t1)), mod);
253 } else if (IsIntegerTerm(t1)) {
254 p = GetIntBBProp(IntegerOfTerm(t1), mod);
255 } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
256 Term tmod = ArgOfTerm(1, t1);
257 if (!IsVarTerm(tmod) ) {
258 mod = tmod;
259 t1 = ArgOfTerm(2, t1);
260 goto restart;
261 } else {
262 Yap_Error(INSTANTIATION_ERROR, t1, msg);
263 return(NULL);
264 }
265 } else {
266 Yap_Error(TYPE_ERROR_ATOM, t1, msg);
267 return(NULL);
268 }
269 return(p);
270}
271
272static Term
273BBPut(Term t0, Term t2)
274{
275 if (!IsVarTerm(t0) && IsApplTerm(t0)) {
276 Yap_ErLogUpdCl((LogUpdClause *)DBRefOfTerm(t0));
277 }
278 if (IsVarTerm(t2) || IsAtomOrIntTerm(t2)) {
279 return t2;
280 } else {
281 LogUpdClause *cl = Yap_new_ludbe(t2, NULL, 0);
282
283 if (cl == NULL) {
284 Yap_ThrowError(SYSTEM_ERROR_INTERNAL,t0,"failed to insert entry in blackboard ~a");
285 }
286 return MkDBRefTerm((DBRef)cl);
287 }
288}
289
298static Int
299p_bb_put( USES_REGS1 )
300{
301 Term t1 = Deref(ARG1);
302 Term mod = CurrentModule;
303 t1 = Yap_StripModule(t1,&mod);
304 BBProp p = AddBBProp(t1, "bb_put/2", mod PASS_REGS);
305
306 if (p == NULL) {
307 return(FALSE);
308 }
309 WRITE_LOCK(p->BBRWLock);
310 /*
311 if (p->Element)
312 fprintf(stderr,"putting %p, size %d\n", p, p->Element->NOfCells);
313 */
314 p->Element = BBPut(p->Element, Deref(ARG2));
315 WRITE_UNLOCK(p->BBRWLock);
316 return (p->Element != 0L);
317}
318
319static Term
320BBGet(Term t, UInt arity USES_REGS)
321{
322 if (IsVarTerm(t)) {
323 return MkVarTerm();
324 } else if (IsAtomOrIntTerm(t)) {
325 return t;
326 } else {
327 return Yap_LUInstance((LogUpdClause *)DBRefOfTerm(t), arity);
328 }
329}
330
339static Int
340p_bb_get( USES_REGS1 )
341{
342 Term t1 = Deref(ARG1);
343 Term mod = CurrentModule;
344 t1 = Yap_StripModule(t1,&mod);
345 BBProp p = FetchBBProp(t1, "bb_get/2", mod);
346 Term out, t0;
347 if (p == NULL || p->Element == 0L)
348 return(FALSE);
349 READ_LOCK(p->BBRWLock);
350 /*
351 if (p->Element)
352 fprintf(stderr,"getting %p, size %d\n", p, p->Element->NOfCells);
353 */
354 t0 = p->Element;
355 READ_UNLOCK(p->BBRWLock);
356 out = BBGet(t0, 2 PASS_REGS);
357 return Yap_unify(ARG2,out);
358}
359
368static Int
369p_bb_delete( USES_REGS1 )
370{
371 Term t1 = Deref(ARG1);
372 BBProp p;
373 Term out, mod = CurrentModule;
374
375 p = FetchBBProp(t1, "bb_delete/2", mod);
376 if (p == NULL || p->Element == 0L)
377 return(FALSE);
378 WRITE_LOCK(p->BBRWLock);
379 out = BBGet(p->Element, 2 PASS_REGS);
380 if (!IsVarTerm(p->Element) && IsApplTerm(p->Element)) {
381 Yap_ErLogUpdCl((LogUpdClause *)DBRefOfTerm(p->Element));
382 }
383 p->Element = 0L;
384 WRITE_UNLOCK(p->BBRWLock);
385 return Yap_unify(ARG2,out);
386}
387
396static Int
397p_bb_update( USES_REGS1 )
398{
399 Term t1 = Deref(ARG1);
400 BBProp p;
401 Term out;
402Term mod = CurrentModule;
403 t1 = Yap_StripModule(t1,&mod);
404 p = FetchBBProp(t1, "bb_update/3", mod);
405 if (p == NULL || p->Element == 0L)
406 return FALSE;
407 WRITE_LOCK(p->BBRWLock);
408 out = BBGet(p->Element, 3 PASS_REGS);
409 if (!Yap_unify(out,ARG2)) {
410 WRITE_UNLOCK(p->BBRWLock);
411 return FALSE;
412 }
413 p->Element = BBPut(p->Element, Deref(ARG3));
414 WRITE_UNLOCK(p->BBRWLock);
415 return (p->Element != 0L);
416}
417
418static Int
419p_resize_bb_int_keys( USES_REGS1 )
420{
421 Term t1 = Deref(ARG1);
422 if (IsVarTerm(t1)) {
423 return(Yap_unify(ARG1,MkIntegerTerm((Int)INT_BB_KEYS_SIZE)));
424 }
425 if (!IsIntegerTerm(t1)) {
426 Yap_Error(TYPE_ERROR_INTEGER, t1, "yap_flag(resize_bb_int_keys,T)");
427 return(FALSE);
428 }
429 return(resize_bb_int_keys(IntegerOfTerm(t1)));
430}
431
432void
433Yap_InitBBPreds(void)
434{
435 Yap_InitCPred("bb_put", 2, p_bb_put, 0);
436 Yap_InitCPred("bb_get", 2, p_bb_get, 0);
437 Yap_InitCPred("bb_delete", 2, p_bb_delete, 0);
438 Yap_InitCPred("bb_update", 3, p_bb_update, 0);
439 Yap_InitCPred("$resize_bb_int_keys", 1, p_resize_bb_int_keys, SafePredFlag|SyncPredFlag);
440}
441
Yap.h
Main definitions.
DB_STRUCT
Definition: Yatom.h:716
logic_upd_clause
Definition: clause.h:64