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: rheap.h *
12 * comments: walk through heap code *
13 * *
14 * Last rev: $Date: 2008-08-07 20:51:23 $,$Author: vsc $ *
15 * $Log: not supported by cvs2svn $
16 * Revision 1.99 2008/07/22 23:34:49 vsc
17 * SWI and module fixes
18 *
19 * Revision 1.98 2008/05/12 22:31:37 vsc
20 * fix previous fixes
21 *
22 * Revision 1.97 2008/05/12 14:04:23 vsc
23 * updates to restore
24 *
25 * Revision 1.96 2008/04/11 16:58:17 ricroc
26 * yapor: seq_def initialization
27 *
28 * Revision 1.95 2008/04/06 12:06:48 vsc
29 * more small fixes
30 *
31 * Revision 1.94 2008/04/06 11:53:02 vsc
32 * fix some restore bugs
33 *
34 * Revision 1.93 2008/04/04 09:10:02 vsc
35 * restore was restoring twice
36 *
37 * Revision 1.92 2008/04/03 11:34:47 vsc
38 * fix restorebb in cases entry key is not an atom (obs from Nicos
39 * Angelopoulos)
40 *
41 * Revision 1.91 2008/04/01 15:31:43 vsc
42 * more saved state fixes
43 *
44 * Revision 1.90 2008/04/01 14:09:43 vsc
45 * improve restore
46 *
47 * Revision 1.89 2008/04/01 09:41:05 vsc
48 * more fixes to restore
49 *
50 * Revision 1.88 2008/04/01 08:42:46 vsc
51 * fix restore and small VISTA thingies
52 *
53 * Revision 1.87 2008/03/25 22:03:14 vsc
54 * fix some icc warnings
55 *
56 * Revision 1.86 2008/03/25 16:45:53 vsc
57 * make or-parallelism compile again
58 *
59 * Revision 1.85 2008/02/12 17:03:52 vsc
60 * SWI-portability changes
61 *
62 * Revision 1.84 2008/02/07 21:39:51 vsc
63 * fix case where predicate is for an integer (DBEntry).
64 *
65 * Revision 1.83 2008/01/23 17:57:55 vsc
66 * valgrind it!
67 * enable atom garbage collection.
68 *
69 * Revision 1.82 2007/12/05 12:17:23 vsc
70 * improve JT
71 * fix graph compatibility with SICStus
72 * re-export declaration.
73 *
74 * Revision 1.81 2007/11/26 23:43:09 vsc
75 * fixes to support threads and assert correctly, even if inefficiently.
76 *
77 * Revision 1.80 2007/11/07 09:35:53 vsc
78 * small fix
79 *
80 * Revision 1.79 2007/11/07 09:25:27 vsc
81 * speedup meta-calls
82 *
83 * Revision 1.78 2007/11/06 17:02:12 vsc
84 * compile ground terms away.
85 *
86 * Revision 1.77 2007/10/10 09:44:24 vsc
87 * some more fixes to make YAP swi compatible
88 * fix absolute_file_name (again)
89 * fix setarg
90 *
91 * Revision 1.76 2007/09/28 23:18:17 vsc
92 * handle learning from interpretations.
93 *
94 * Revision 1.75 2007/04/10 22:13:21 vsc
95 * fix max modules limitation
96 *
97 * Revision 1.74 2007/03/22 11:12:21 vsc
98 * make sure that YAP_Restart does not restart a failed goal.
99 *
100 * Revision 1.73 2007/02/18 00:26:36 vsc
101 * fix atom garbage collector (although it is still off by default)
102 * make valgrind feel better
103 *
104 * Revision 1.72 2007/01/08 08:27:19 vsc
105 * fix restore (Trevor)
106 * make indexing a bit faster on IDB
107 *
108 * Revision 1.71 2006/11/27 17:42:03 vsc
109 * support for UNICODE, and other bug fixes.
110 *
111 * Revision 1.70 2006/08/25 19:50:35 vsc
112 * global data structures
113 *
114 * Revision 1.69 2006/08/22 16:12:46 vsc
115 * global variables
116 *
117 * Revision 1.68 2006/08/02 18:18:30 vsc
118 * preliminary support for readutil library (SWI compatible).
119 *
120 * Revision 1.67 2006/05/17 18:38:11 vsc
121 * make system library use true file name
122 *
123 * Revision 1.66 2006/04/28 15:48:33 vsc
124 * do locking on streams
125 *
126 * Revision 1.65 2006/04/28 13:23:23 vsc
127 * fix number of overflow bugs affecting threaded version
128 * make current_op faster.
129 *
130 * Revision 1.64 2006/03/22 20:07:28 vsc
131 * take better care of zombies
132 *
133 * Revision 1.63 2006/03/06 14:04:56 vsc
134 * fixes to garbage collector
135 * fixes to debugger
136 *
137 * Revision 1.62 2006/02/24 14:03:42 vsc
138 * fix refs to old LogUpd implementation (pre 5).
139 *
140 * Revision 1.61 2006/01/02 02:16:18 vsc
141 * support new interface between YAP and GMP, so that we don't rely on our own
142 * allocation routines.
143 * Several big fixes.
144 *
145 * Revision 1.60 2005/12/17 03:25:39 vsc
146 * major changes to support online event-based profiling
147 * improve error discovery and restart on scanner.
148 *
149 * Revision 1.59 2005/12/05 17:16:11 vsc
150 * write_depth/3
151 * overflow handlings and garbage collection
152 * Several ipdates to CLPBN
153 * dif/2 could be broken in the presence of attributed variables.
154 *
155 * Revision 1.58 2005/11/23 03:01:33 vsc
156 * fix several bugs in save/restore.b
157 *
158 * Revision 1.57 2005/10/28 17:38:50 vsc
159 * sveral updates
160 *
161 * Revision 1.56 2005/10/21 16:09:03 vsc
162 * SWI compatible module only operators
163 *
164 * Revision 1.55 2005/10/19 19:00:48 vsc
165 * extend arrays with nb_terms so that we can implement nb_ builtins
166 * correctly.
167 *
168 * Revision 1.54 2005/09/09 17:24:39 vsc
169 * a new and hopefully much better implementation of atts.
170 *
171 * Revision 1.53 2005/08/01 15:40:38 ricroc
172 * TABLING NEW: better support for incomplete tabling
173 *
174 * Revision 1.52 2005/07/06 19:34:11 ricroc
175 * TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure.
176 *
177 * Revision 1.51 2005/07/06 15:10:15 vsc
178 * improvements to compiler: merged instructions and fixes for ->
179 *
180 * Revision 1.50 2005/06/01 13:53:46 vsc
181 * improve bb routines to use the DB efficiently
182 * change interface between DB and BB.
183 *
184 * Revision 1.49 2005/05/30 03:26:37 vsc
185 * add some atom gc fixes
186 *
187 * Revision 1.48 2005/01/04 02:50:21 vsc
188 * - allow MegaClauses with blobs
189 * - change Diffs to be thread specific
190 * - include Christian's updates
191 *
192 * Revision 1.47 2004/12/02 06:06:47 vsc
193 * fix threads so that they at least start
194 * allow error handling to work with threads
195 * replace heap_base by Yap_heap_base, according to Yap's convention for globals.
196 *
197 * Revision 1.46 2004/11/23 21:16:21 vsc
198 * A few extra fixes for saved states.
199 *
200 * Revision 1.45 2004/10/26 20:16:18 vsc
201 * More bug fixes for overflow handling
202 *
203 * Revision 1.44 2004/10/06 16:55:47 vsc
204 * change configure to support big mem configs
205 * get rid of extra globals
206 * fix trouble with multifile preds
207 *
208 * Revision 1.43 2004/09/27 20:45:04 vsc
209 * Mega clauses
210 * Fixes to sizeof(expand_clauses) which was being overestimated
211 * Fixes to profiling+indexing
212 * Fixes to reallocation of memory after restoring
213 * Make sure all clauses, even for C, end in _Ystop
214 * Don't reuse space for Streams
215 * Fix Stream_F on StreaNo+1
216 *
217 * Revision 1.42 2004/06/05 03:37:00 vsc
218 * coroutining is now a part of attvars.
219 * some more fixes.
220 *
221 * Revision 1.41 2004/04/29 03:45:50 vsc
222 * fix garbage collection in execute_tail
223 *
224 * Revision 1.40 2004/03/31 01:03:10 vsc
225 * support expand group of clauses
226 *
227 * Revision 1.39 2004/03/19 11:35:42 vsc
228 * trim_trail for default machine
229 * be more aggressive about try-retry-trust chains.
230 * - handle cases where block starts with a wait
231 * - don't use _killed instructions, just let the thing rot by itself.
232 * *
233 * *
234 *************************************************************************/
235 #ifdef SCCS
236 static char SccsId[] = "@(#)rheap.c 1.3 3/15/90";
237 #endif
238
239 #define Atomics 0
240 #define Funcs 1
241
242 static Term
ConstantTermAdjust(Term t)243 ConstantTermAdjust (Term t)
244 {
245 if (IsAtomTerm(t))
246 return AtomTermAdjust(t);
247 return t;
248 }
249
250 static Term
DBGroundTermAdjust(Term t)251 DBGroundTermAdjust (Term t)
252 {
253 /* The term itself is restored by dbtermlist */
254 if (IsPairTerm(t)) {
255 return AbsPair(PtoHeapCellAdjust(RepPair(t)));
256 } else {
257 return AbsAppl(PtoHeapCellAdjust(RepAppl(t)));
258 }
259 }
260
261 /* Now, everything on its place so you must adjust the pointers */
262
263 static void
do_clean_susp_clauses(yamop * ipc)264 do_clean_susp_clauses(yamop *ipc) {
265 COUNT i;
266 yamop **st = (yamop **)NEXTOP(ipc,sssllp);
267
268 ipc->opc = Yap_opcode(_expand_clauses);
269 ipc->u.sssllp.p = PtoPredAdjust(ipc->u.sssllp.p);
270 if (ipc->u.sssllp.sprev) {
271 ipc->u.sssllp.sprev = PtoOpAdjust(ipc->u.sssllp.sprev);
272 }
273 if (ipc->u.sssllp.snext) {
274 ipc->u.sssllp.snext = PtoOpAdjust(ipc->u.sssllp.snext);
275 }
276 for (i = 0; i < ipc->u.sssllp.s1; i++, st++) {
277 if (*st) {
278 *st = PtoOpAdjust(*st);
279 }
280 }
281 }
282
283 static void
AdjustSwitchTable(op_numbers op,yamop * table,COUNT i)284 AdjustSwitchTable(op_numbers op, yamop *table, COUNT i)
285 {
286 CELL *startcode = (CELL *)table;
287 /* in case the table is already gone */
288 if (!table)
289 return;
290 switch (op) {
291 case _switch_on_func:
292 {
293 COUNT j;
294 CELL *oldcode;
295
296 oldcode = startcode;
297 for (j = 0; j < i; j++) {
298 Functor oldfunc = (Functor)(oldcode[0]);
299 CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
300 if (oldfunc) {
301 oldcode[0] = (CELL)FuncAdjust(oldfunc);
302 }
303 oldcode[1] = (CELL)CodeAddrAdjust(oldjmp);
304 oldcode += 2;
305 }
306 rehash(startcode, i, Funcs);
307 }
308 break;
309 case _switch_on_cons:
310 {
311 COUNT j;
312 CELL *oldcode;
313
314 #if !defined(USE_OFFSETS)
315 oldcode = startcode;
316 #endif
317 for (j = 0; j < i; j++) {
318 Term oldcons = oldcode[0];
319 CODEADDR oldjmp = (CODEADDR)(oldcode[1]);
320 if (oldcons != 0x0 && IsAtomTerm(oldcons)) {
321 oldcode[0] = AtomTermAdjust(oldcons);
322 }
323 oldcode[1] = (CELL)CodeAddrAdjust(oldjmp);
324 oldcode += 2;
325 }
326 #if !USE_OFFSETS
327 rehash(startcode, i, Atomics);
328 #endif
329 }
330 break;
331 case _go_on_func:
332 {
333 Functor oldfunc = (Functor)(startcode[0]);
334
335 startcode[0] = (CELL)FuncAdjust(oldfunc);
336 startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]);
337 startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]);
338 }
339 break;
340 case _go_on_cons:
341 {
342 Term oldcons = startcode[0];
343
344 if (IsAtomTerm(oldcons)) {
345 startcode[0] = AtomTermAdjust(oldcons);
346 }
347 startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]);
348 startcode[3] = (CELL)CodeAddrAdjust((CODEADDR)startcode[3]);
349 }
350 break;
351 case _if_func:
352 {
353 Int j;
354
355 for (j = 0; j < i; j++) {
356 Functor oldfunc = (Functor)(startcode[0]);
357 CODEADDR oldjmp = (CODEADDR)(startcode[1]);
358 startcode[0] = (CELL)FuncAdjust(oldfunc);
359 startcode[1] = (CELL)CodeAddrAdjust(oldjmp);
360 startcode += 2;
361 }
362 /* adjust fail code */
363 startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]);
364 }
365 break;
366 case _if_cons:
367 {
368 Int j;
369
370 for (j = 0; j < i; j++) {
371 Term oldcons = startcode[0];
372 CODEADDR oldjmp = (CODEADDR)(startcode[1]);
373 if (IsAtomTerm(oldcons)) {
374 startcode[0] = (CELL)AtomTermAdjust(oldcons);
375 }
376 startcode[1] = (CELL)CodeAddrAdjust(oldjmp);
377 startcode += 2;
378 }
379 /* adjust fail code */
380 startcode[1] = (CELL)CodeAddrAdjust((CODEADDR)startcode[1]);
381 }
382 break;
383 default:
384 Yap_Error(INTERNAL_ERROR,0L,"Opcode Not Implemented in AdjustSwitchTable");
385 }
386 }
387
388 STATIC_PROTO(void RestoreAtomList, (Atom));
389 STATIC_PROTO(void RestoreAtom, (AtomEntry *));
390 STATIC_PROTO(void RestoreHashPreds, (void));
391
392 static void
RestoreAtoms(void)393 RestoreAtoms(void)
394 {
395 AtomHashEntry *HashPtr;
396 register int i;
397
398 Yap_heap_regs->hash_chain =
399 PtoAtomHashEntryAdjust(Yap_heap_regs->hash_chain);
400 HashPtr = HashChain;
401 for (i = 0; i < AtomHashTableSize; ++i) {
402 HashPtr->Entry = NoAGCAtomAdjust(HashPtr->Entry);
403 RestoreAtomList(HashPtr->Entry);
404 HashPtr++;
405 }
406 }
407
408 static void
RestoreWideAtoms(void)409 RestoreWideAtoms(void)
410 {
411 AtomHashEntry *HashPtr;
412 register int i;
413
414 Yap_heap_regs->wide_hash_chain =
415 PtoAtomHashEntryAdjust(Yap_heap_regs->wide_hash_chain);
416 HashPtr = WideHashChain;
417 for (i = 0; i < WideAtomHashTableSize; ++i) {
418 HashPtr->Entry = AtomAdjust(HashPtr->Entry);
419 RestoreAtomList(HashPtr->Entry);
420 HashPtr++;
421 }
422 }
423
424 static void
RestoreInvisibleAtoms(void)425 RestoreInvisibleAtoms(void)
426 {
427 INVISIBLECHAIN.Entry = AtomAdjust(INVISIBLECHAIN.Entry);
428 RestoreAtomList(INVISIBLECHAIN.Entry);
429 RestoreAtom(RepAtom(AtomFoundVar));
430 RestoreAtom(RepAtom(AtomFreeTerm));
431 }
432
433 #include "rclause.h"
434
435 /* adjusts terms stored in the data base, when they have no variables */
436 static Term
AdjustDBTerm(Term trm,Term * p_base)437 AdjustDBTerm(Term trm, Term *p_base)
438 {
439 if (IsVarTerm(trm))
440 return CodeVarAdjust(trm);
441 if (IsAtomTerm(trm))
442 return AtomTermAdjust(trm);
443 if (IsPairTerm(trm)) {
444 Term *p;
445 Term out;
446
447 p = PtoHeapCellAdjust(RepPair(trm));
448 out = AbsPair(p);
449 loop:
450 if (p >= p_base) {
451 p[0] = AdjustDBTerm(p[0], p);
452 if (IsPairTerm(p[1])) {
453 /* avoid term recursion with very deep lists */
454 Term *newp = PtoHeapCellAdjust(RepPair(p[1]));
455 p[1] = AbsPair(newp);
456 p_base = p;
457 p = newp;
458 goto loop;
459 } else {
460 p[1] = AdjustDBTerm(p[1], p);
461 }
462 }
463 return out;
464 }
465 if (IsApplTerm(trm)) {
466 Term *p;
467 Functor f;
468 Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm));
469 /* if it is before the current position, then we are looking
470 at old code */
471 if (p >= p_base) {
472 f = (Functor)p[0];
473 if (!IsExtensionFunctor(f)) {
474 UInt Arity, i;
475
476 f = FuncAdjust(f);
477 *p++ = (Term)f;
478 Arity = ArityOfFunctor(f);
479 for (i = 0; i < Arity; ++i) {
480 *p = AdjustDBTerm(*p, p0);
481 p++;
482 }
483 }
484 }
485 return AbsAppl(p0);
486 }
487 return trm;
488 }
489
490 static void
RestoreDBTerm(DBTerm * dbr,int attachments)491 RestoreDBTerm(DBTerm *dbr, int attachments)
492 {
493 if (attachments) {
494 #ifdef COROUTINING
495 if (dbr->ag.attachments)
496 dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents);
497 #endif
498 } else {
499 if (dbr->ag.NextDBT)
500 dbr->ag.NextDBT = DBTermAdjust(dbr->ag.NextDBT);
501 }
502 if (dbr->DBRefs != NULL) {
503 DBRef *cp;
504 DBRef tm;
505
506 dbr->DBRefs = DBRefPAdjust(dbr->DBRefs);
507 cp = dbr->DBRefs;
508 while ((tm = *--cp) != 0)
509 *cp = DBRefAdjust(tm);
510 }
511 dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents);
512 }
513
514 /* Restoring the heap */
515
516 /* Restores a prolog clause, in its compiled form */
517 static void
RestoreStaticClause(StaticClause * cl)518 RestoreStaticClause(StaticClause *cl)
519 /*
520 * Cl points to the start of the code, IsolFlag tells if we have a single
521 * clause for this predicate or not
522 */
523 {
524 if (cl->ClFlags & FactMask) {
525 cl->usc.ClPred = PtoPredAdjust(cl->usc.ClPred);
526 } else {
527 cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource);
528 }
529 if (cl->ClNext) {
530 cl->ClNext = PtoStCAdjust(cl->ClNext);
531 }
532 restore_opcodes(cl->ClCode, NULL);
533 }
534
535 /* Restores a prolog clause, in its compiled form */
536 static void
RestoreMegaClause(MegaClause * cl)537 RestoreMegaClause(MegaClause *cl)
538 /*
539 * Cl points to the start of the code, IsolFlag tells if we have a single
540 * clause for this predicate or not
541 */
542 {
543 UInt ncls, i;
544 yamop *ptr;
545
546 cl->ClPred = PtoPredAdjust(cl->ClPred);
547 if (cl->ClNext) {
548 cl->ClNext = (MegaClause *)AddrAdjust((ADDR)(cl->ClNext));
549 }
550 ncls = cl->ClPred->cs.p_code.NOfClauses;
551
552 for (i = 0, ptr = cl->ClCode; i < ncls; i++) {
553 yamop *nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
554 restore_opcodes(ptr, nextptr);
555 ptr = nextptr;
556 }
557 }
558
559 /* Restores a prolog clause, in its compiled form */
560 static void
RestoreDynamicClause(DynamicClause * cl,PredEntry * pp)561 RestoreDynamicClause(DynamicClause *cl, PredEntry *pp)
562 /*
563 * Cl points to the start of the code, IsolFlag tells if we have a single
564 * clause for this predicate or not
565 */
566 {
567 if (cl->ClPrevious != NULL) {
568 cl->ClPrevious = PtoOpAdjust(cl->ClPrevious);
569 }
570 INIT_LOCK(cl->ClLock);
571 restore_opcodes(cl->ClCode, NULL);
572 }
573
574 /* Restores a prolog clause, in its compiled form */
575 static void
RestoreLUClause(LogUpdClause * cl,PredEntry * pp)576 RestoreLUClause(LogUpdClause *cl, PredEntry *pp)
577 /*
578 * Cl points to the start of the code, IsolFlag tells if we have a single
579 * clause for this predicate or not
580 */
581 {
582 // INIT_LOCK(cl->ClLock);
583 if (cl->ClFlags & LogUpdRuleMask) {
584 cl->ClExt = PtoOpAdjust(cl->ClExt);
585 }
586 if (cl->ClSource) {
587 cl->ClSource = DBTermAdjust(cl->ClSource);
588 RestoreDBTerm(cl->ClSource, TRUE);
589 }
590 if (cl->ClPrev) {
591 cl->ClPrev = PtoLUCAdjust(cl->ClPrev);
592 }
593 if (cl->ClNext) {
594 cl->ClNext = PtoLUCAdjust(cl->ClNext);
595 }
596 cl->ClPred = PtoPredAdjust(cl->ClPred);
597 restore_opcodes(cl->ClCode, NULL);
598 }
599
600 static void
RestoreDBTermEntry(struct dbterm_list * dbl)601 RestoreDBTermEntry(struct dbterm_list *dbl) {
602 DBTerm *dbt;
603
604 if (dbl->dbterms)
605 dbt = dbl->dbterms = DBTermAdjust(dbl->dbterms);
606 else
607 return;
608 dbl->clause_code = PtoOpAdjust(dbl->clause_code);
609 if (dbl->next_dbl)
610 dbl->next_dbl = PtoDBTLAdjust(dbl->next_dbl);
611 dbl->p = PredEntryAdjust(dbl->p);
612 while (dbt) {
613 RestoreDBTerm(dbt, FALSE);
614 dbt = dbt->ag.NextDBT;
615 }
616 }
617
618 static void
CleanLUIndex(LogUpdIndex * idx,int recurse)619 CleanLUIndex(LogUpdIndex *idx, int recurse)
620 {
621 // INIT_LOCK(idx->ClLock);
622 idx->ClPred = PtoPredAdjust(idx->ClPred);
623 if (idx->ParentIndex)
624 idx->ParentIndex = LUIndexAdjust(idx->ParentIndex);
625 if (idx->PrevSiblingIndex) {
626 idx->PrevSiblingIndex = LUIndexAdjust(idx->PrevSiblingIndex);
627 }
628 if (idx->SiblingIndex) {
629 idx->SiblingIndex = LUIndexAdjust(idx->SiblingIndex);
630 if (recurse)
631 CleanLUIndex(idx->SiblingIndex, TRUE);
632 }
633 if (idx->ChildIndex) {
634 idx->ChildIndex = LUIndexAdjust(idx->ChildIndex);
635 if (recurse)
636 CleanLUIndex(idx->ChildIndex, TRUE);
637 }
638 if (!(idx->ClFlags & SwitchTableMask)) {
639 restore_opcodes(idx->ClCode, NULL);
640 }
641 }
642
643 static void
CleanSIndex(StaticIndex * idx,int recurse)644 CleanSIndex(StaticIndex *idx, int recurse)
645 {
646 beginning:
647 if (!(idx->ClFlags & SwitchTableMask)) {
648 restore_opcodes(idx->ClCode, NULL);
649 }
650 idx->ClPred = PtoPredAdjust(idx->ClPred);
651 if (idx->ChildIndex) {
652 idx->ChildIndex = SIndexAdjust(idx->ChildIndex);
653 if (recurse)
654 CleanSIndex(idx->ChildIndex, TRUE);
655 }
656 if (idx->SiblingIndex) {
657 idx->SiblingIndex = SIndexAdjust(idx->SiblingIndex);
658 /* use loop to avoid recursion with very complex indices */
659 if (recurse) {
660 idx = idx->SiblingIndex;
661 goto beginning;
662 }
663 }
664 }
665
666 static void
RestoreSWIAtoms(void)667 RestoreSWIAtoms(void)
668 {
669 int i, j;
670 for (i=0; i < N_SWI_ATOMS; i++) {
671 SWI_Atoms[i] = AtomAdjust(SWI_Atoms[i]);
672 }
673 for (j=0; j < N_SWI_FUNCTORS; j++) {
674 SWI_Functors[j] = FuncAdjust(SWI_Functors[j]);
675 }
676 RestoreSWIHash();
677 }
678
679 static void
RestoreSWIBlobs(void)680 RestoreSWIBlobs(void)
681 {
682 }
683
684 static void
RestorePredHash(void)685 RestorePredHash(void)
686 {
687 PredHash = PtoPtoPredAdjust(PredHash);
688 if (PredHash == NULL) {
689 Yap_Error(FATAL_ERROR,MkIntTerm(0),"restore should find predicate hash table");
690 }
691 REINIT_RWLOCK(PredHashRWLock);
692 RestoreHashPreds(); /* does most of the work */
693 }
694
695 static void
RestoreEnvInst(yamop start[2],yamop ** instp,op_numbers opc,PredEntry * pred)696 RestoreEnvInst(yamop start[2], yamop **instp, op_numbers opc, PredEntry *pred)
697 {
698 yamop *ipc = start;
699
700 ipc->opc = Yap_opcode(_call);
701 ipc->u.Osbpp.p = pred;
702 ipc->u.Osbpp.p0 = pred;
703 ipc = NEXTOP(ipc, Osbpp);
704 ipc->opc = Yap_opcode(opc);
705 *instp = ipc;
706 }
707
708 static void
RestoreOtaplInst(yamop start[1],OPCODE opc,PredEntry * pe)709 RestoreOtaplInst(yamop start[1], OPCODE opc, PredEntry *pe)
710 {
711 yamop *ipc = start;
712
713 /* this is a place holder, it should not really be used */
714 ipc->opc = Yap_opcode(opc);
715 ipc->u.Otapl.s = 0;
716 ipc->u.Otapl.p = pe;
717 if (ipc->u.Otapl.d)
718 ipc->u.Otapl.d = PtoOpAdjust(ipc->u.Otapl.d);
719 #ifdef YAPOR
720 INIT_YAMOP_LTT(ipc, 1);
721 #endif /* YAPOR */
722 #ifdef TABLING
723 ipc->u.Otapl.te = NULL;
724 #endif /* TABLING */
725 }
726
727 static void
RestoreDBTermsList(void)728 RestoreDBTermsList(void)
729 {
730 if (Yap_heap_regs->dbterms_list) {
731 struct dbterm_list *dbl = PtoDBTLAdjust(Yap_heap_regs->dbterms_list);
732 Yap_heap_regs->dbterms_list = dbl;
733 while (dbl) {
734 RestoreDBTermEntry(dbl);
735 dbl = dbl->next_dbl;
736 }
737 }
738 }
739
740 static void
RestoreExpandList(void)741 RestoreExpandList(void)
742 {
743 if (Yap_heap_regs->expand_clauses_first)
744 Yap_heap_regs->expand_clauses_first = PtoOpAdjust(Yap_heap_regs->expand_clauses_first);
745 if (Yap_heap_regs->expand_clauses_last)
746 Yap_heap_regs->expand_clauses_last = PtoOpAdjust(Yap_heap_regs->expand_clauses_last);
747 {
748 yamop *ptr = Yap_heap_regs->expand_clauses_first;
749 while (ptr) {
750 do_clean_susp_clauses(ptr);
751 ptr = ptr->u.sssllp.snext;
752 }
753 }
754 }
755
756 static void
RestoreUdiControlBlocks(void)757 RestoreUdiControlBlocks(void)
758 {
759 if (Yap_heap_regs->udi_control_blocks) {
760 Yap_Error(SYSTEM_ERROR, TermNil,
761 "YAP cannot restore UDI entries!!\n");
762 }
763 }
764
765 static void
RestoreIntKeys(void)766 RestoreIntKeys(void)
767 {
768 if (Yap_heap_regs->IntKeys != NULL) {
769 Yap_heap_regs->IntKeys = (Prop *)AddrAdjust((ADDR)(Yap_heap_regs->IntKeys));
770 {
771 UInt i;
772 for (i = 0; i < Yap_heap_regs->int_keys_size; i++) {
773 if (Yap_heap_regs->IntKeys[i] != NIL) {
774 Prop p0 = Yap_heap_regs->IntKeys[i] = PropAdjust(Yap_heap_regs->IntKeys[i]);
775 RestoreEntries(RepProp(p0), TRUE);
776 }
777 }
778 }
779 }
780 }
781
782 static void
RestoreIntLUKeys(void)783 RestoreIntLUKeys(void)
784 {
785 if (Yap_heap_regs->IntLUKeys != NULL) {
786 Yap_heap_regs->IntLUKeys = (Prop *)AddrAdjust((ADDR)(Yap_heap_regs->IntLUKeys));
787 {
788 Int i;
789 for (i = 0; i < INT_KEYS_SIZE; i++) {
790 Prop p0 = INT_LU_KEYS[i];
791 if (p0) {
792 p0 = PropAdjust(p0);
793 INT_LU_KEYS[i] = p0;
794 while (p0) {
795 PredEntry *pe = RepPredProp(p0);
796 pe->NextOfPE =
797 PropAdjust(pe->NextOfPE);
798 CleanCode(pe);
799 p0 = RepProp(pe->NextOfPE);
800 }
801 }
802 }
803 }
804 }
805 }
806
807 static void
RestoreIntBBKeys(void)808 RestoreIntBBKeys(void)
809 {
810 if (Yap_heap_regs->IntBBKeys != NULL) {
811 Yap_heap_regs->IntBBKeys = (Prop *)AddrAdjust((ADDR)(Yap_heap_regs->IntBBKeys));
812 {
813 UInt i;
814 for (i = 0; i < Yap_heap_regs->int_bb_keys_size; i++) {
815 if (Yap_heap_regs->IntBBKeys[i] != NIL) {
816 Prop p0 = Yap_heap_regs->IntBBKeys[i] = PropAdjust(Yap_heap_regs->IntBBKeys[i]);
817 RestoreEntries(RepProp(p0), TRUE);
818 }
819 }
820 }
821 }
822 }
823
824 static void
RestoreDBErasedMarker(void)825 RestoreDBErasedMarker(void)
826 {
827 Yap_heap_regs->db_erased_marker =
828 DBRefAdjust(Yap_heap_regs->db_erased_marker);
829 Yap_heap_regs->db_erased_marker->id = FunctorDBRef;
830 Yap_heap_regs->db_erased_marker->Flags = ErasedMask;
831 Yap_heap_regs->db_erased_marker->Code = NULL;
832 Yap_heap_regs->db_erased_marker->DBT.DBRefs = NULL;
833 Yap_heap_regs->db_erased_marker->Parent = NULL;
834 }
835
836 static void
RestoreLogDBErasedMarker(void)837 RestoreLogDBErasedMarker(void)
838 {
839 Yap_heap_regs->logdb_erased_marker =
840 PtoLUCAdjust(Yap_heap_regs->logdb_erased_marker);
841 Yap_heap_regs->logdb_erased_marker->Id = FunctorDBRef;
842 Yap_heap_regs->logdb_erased_marker->ClFlags = ErasedMask|LogUpdMask;
843 Yap_heap_regs->logdb_erased_marker->ClSource = NULL;
844 Yap_heap_regs->logdb_erased_marker->ClRefCount = 0;
845 Yap_heap_regs->logdb_erased_marker->ClPred = PredLogUpdClause;
846 Yap_heap_regs->logdb_erased_marker->ClExt = NULL;
847 Yap_heap_regs->logdb_erased_marker->ClPrev = NULL;
848 Yap_heap_regs->logdb_erased_marker->ClNext = NULL;
849 Yap_heap_regs->logdb_erased_marker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
850 Yap_heap_regs->logdb_erased_marker->ClCode->opc = Yap_opcode(_op_fail);
851 INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker);
852 }
853
854 static void
RestoreDeadStaticClauses(void)855 RestoreDeadStaticClauses(void)
856 {
857 if (Yap_heap_regs->dead_static_clauses) {
858 StaticClause *sc = PtoStCAdjust(Yap_heap_regs->dead_static_clauses);
859 Yap_heap_regs->dead_static_clauses = sc;
860 while (sc) {
861 RestoreStaticClause(sc);
862 sc = sc->ClNext;
863 }
864 }
865 }
866
867 static void
RestoreDeadMegaClauses(void)868 RestoreDeadMegaClauses(void)
869 {
870 if (Yap_heap_regs->dead_mega_clauses) {
871 MegaClause *mc = (MegaClause *)AddrAdjust((ADDR)(Yap_heap_regs->dead_mega_clauses));
872 Yap_heap_regs->dead_mega_clauses = mc;
873 while (mc) {
874 RestoreMegaClause(mc);
875 mc = mc->ClNext;
876 }
877 }
878 }
879
880 static void
RestoreDeadStaticIndices(void)881 RestoreDeadStaticIndices(void)
882 {
883 if (Yap_heap_regs->dead_static_indices) {
884 StaticIndex *si = (StaticIndex *)AddrAdjust((ADDR)(Yap_heap_regs->dead_static_indices));
885 Yap_heap_regs->dead_static_indices = si;
886 while (si) {
887 CleanSIndex(si, FALSE);
888 si = si->SiblingIndex;
889 }
890 }
891 }
892
893 static void
RestoreDBErasedList(void)894 RestoreDBErasedList(void)
895 {
896 if (Yap_heap_regs->db_erased_list) {
897 LogUpdClause *lcl = Yap_heap_regs->db_erased_list =
898 PtoLUCAdjust(Yap_heap_regs->db_erased_list);
899 while (lcl) {
900 RestoreLUClause(lcl, FALSE);
901 lcl = lcl->ClNext;
902 }
903 }
904 }
905
906 static void
RestoreDBErasedIList(void)907 RestoreDBErasedIList(void)
908 {
909 if (Yap_heap_regs->db_erased_ilist) {
910 LogUpdIndex *icl = Yap_heap_regs->db_erased_ilist =
911 LUIndexAdjust(Yap_heap_regs->db_erased_ilist);
912 while (icl) {
913 CleanLUIndex(icl, FALSE);
914 icl = icl->SiblingIndex;
915 }
916 }
917 }
918
919 static void
RestoreStreams(void)920 RestoreStreams(void)
921 {
922 if (Yap_heap_regs->yap_streams != NULL) {
923 int sno;
924
925 Yap_heap_regs->yap_streams =
926 (struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams);
927 for (sno = 0; sno < MaxStreams; ++sno) {
928 if (Stream[sno].status & Free_Stream_f)
929 continue;
930 if (Stream[sno].status & (Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f))
931 continue;
932 Stream[sno].u.file.user_name = AtomTermAdjust(Stream[sno].u.file.user_name);
933 Stream[sno].u.file.name = AtomAdjust(Stream[sno].u.file.name);
934 }
935 }
936 }
937
938 static void
RestoreAliases(void)939 RestoreAliases(void)
940 {
941 if (Yap_heap_regs->file_aliases != NULL) {
942 int i;
943
944 Yap_heap_regs->file_aliases =
945 (struct AliasDescS *)AddrAdjust((ADDR)Yap_heap_regs->file_aliases);
946 for (i = 0; i < NOfFileAliases; i++)
947 FileAliases[i].name = AtomAdjust(FileAliases[i].name);
948 }
949 }
950
951 static void
RestoreForeignCode(void)952 RestoreForeignCode(void)
953 {
954 ForeignObj *f_code;
955
956 if (!ForeignCodeLoaded)
957 return;
958 if (ForeignCodeLoaded != NULL)
959 ForeignCodeLoaded = (void *)AddrAdjust((ADDR)ForeignCodeLoaded);
960 f_code = ForeignCodeLoaded;
961 while (f_code != NULL) {
962 StringList objs, libs;
963 if (f_code->objs != NULL)
964 f_code->objs = (StringList)AddrAdjust((ADDR)f_code->objs);
965 objs = f_code->objs;
966 while (objs != NULL) {
967 if (objs->next != NULL)
968 objs->next = (StringList)AddrAdjust((ADDR)objs->next);
969 objs->name = AtomAdjust(objs->name);
970 objs = objs->next;
971 }
972 if (f_code->libs != NULL)
973 f_code->libs = (StringList)AddrAdjust((ADDR)f_code->libs);
974 libs = f_code->libs;
975 while (libs != NULL) {
976 if (libs->next != NULL)
977 libs->next = (StringList)AddrAdjust((ADDR)libs->next);
978 libs->name = AtomAdjust(libs->name);
979 libs = libs->next;
980 }
981 if (f_code->f != NULL)
982 f_code->f = (char *)AddrAdjust((ADDR)f_code->f);
983 if (f_code->next != NULL)
984 f_code->next = (ForeignObj *)AddrAdjust((ADDR)f_code->next);
985 f_code = f_code->next;
986 }
987 }
988
989 static void
RestoreYapRecords(void)990 RestoreYapRecords(void)
991 {
992 struct record_list *ptr;
993
994 Yap_Records = DBRecordAdjust(Yap_Records);
995 ptr = Yap_Records;
996 while (ptr) {
997 ptr->next_rec = DBRecordAdjust(ptr->next_rec);
998 ptr->prev_rec = DBRecordAdjust(ptr->prev_rec);
999 ptr->dbrecord = DBTermAdjust(ptr->dbrecord);
1000 RestoreDBTerm(ptr->dbrecord, FALSE);
1001 }
1002 }
1003
1004 static void
RestoreBallTerm(int wid)1005 RestoreBallTerm(int wid)
1006 {
1007 if (BallTerm) {
1008 BallTerm = DBTermAdjust(BallTerm);
1009 RestoreDBTerm(BallTerm, TRUE);
1010 }
1011 }
1012
1013 #include "rglobals.h"
1014
1015 /* restore the failcodes */
1016 static void
restore_codes(void)1017 restore_codes(void)
1018 {
1019 Yap_heap_regs->heap_top = AddrAdjust(OldHeapTop);
1020 #include "rhstruct.h"
1021 RestoreGlobal();
1022 #ifndef worker_id
1023 #define worker_id 0
1024 #endif
1025 RestoreWorker(worker_id);
1026 }
1027
1028
1029 static void
RestoreDBEntry(DBRef dbr)1030 RestoreDBEntry(DBRef dbr)
1031 {
1032 #ifdef DEBUG_RESTORE
1033 fprintf(stderr, "Restoring at %x", dbr);
1034 if (dbr->Flags & DBAtomic)
1035 fprintf(stderr, " an atomic term\n");
1036 else if (dbr->Flags & DBNoVars)
1037 fprintf(stderr, " with no vars\n");
1038 else if (dbr->Flags & DBComplex)
1039 fprintf(stderr, " complex term\n");
1040 else if (dbr->Flags & DBIsRef)
1041 fprintf(stderr, " a ref\n");
1042 else
1043 fprintf(stderr, " a var\n");
1044 #endif
1045 RestoreDBTerm(&(dbr->DBT), TRUE);
1046 if (dbr->Parent) {
1047 dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
1048 }
1049 if (dbr->Code != NULL)
1050 dbr->Code = PtoOpAdjust(dbr->Code);
1051 if (dbr->Prev != NULL)
1052 dbr->Prev = DBRefAdjust(dbr->Prev);
1053 if (dbr->Next != NULL)
1054 dbr->Next = DBRefAdjust(dbr->Next);
1055 #ifdef DEBUG_RESTORE2
1056 fprintf(stderr, "Recomputing masks\n");
1057 #endif
1058 recompute_mask(dbr);
1059 }
1060
1061 /* Restores a DB structure, as it was saved in the heap */
1062 static void
RestoreDB(DBEntry * pp)1063 RestoreDB(DBEntry *pp)
1064 {
1065 register DBRef dbr;
1066
1067 if (pp->First != NULL)
1068 pp->First = DBRefAdjust(pp->First);
1069 if (pp->Last != NULL)
1070 pp->Last = DBRefAdjust(pp->Last);
1071 if (pp->ArityOfDB)
1072 pp->FunctorOfDB = FuncAdjust(pp->FunctorOfDB);
1073 else
1074 pp->FunctorOfDB = (Functor) AtomAdjust((Atom)(pp->FunctorOfDB));
1075 if (pp->F0 != NULL)
1076 pp->F0 = DBRefAdjust(pp->F0);
1077 if (pp->L0 != NULL)
1078 pp->L0 = DBRefAdjust(pp->L0);
1079 /* immediate update semantics */
1080 dbr = pp->F0;
1081 /* While we have something in the data base, even if erased, restore it */
1082 while (dbr) {
1083 RestoreDBEntry(dbr);
1084 if (dbr->n != NULL)
1085 dbr->n = DBRefAdjust(dbr->n);
1086 if (dbr->p != NULL)
1087 dbr->p = DBRefAdjust(dbr->p);
1088 dbr = dbr->n;
1089 }
1090 }
1091
1092 /*
1093 * Restores a group of clauses for the same predicate, starting with First
1094 * and ending with Last, First may be equal to Last
1095 */
1096 static void
CleanClauses(yamop * First,yamop * Last,PredEntry * pp)1097 CleanClauses(yamop *First, yamop *Last, PredEntry *pp)
1098 {
1099 if (pp->PredFlags & LogUpdatePredFlag) {
1100 LogUpdClause *cl = ClauseCodeToLogUpdClause(First);
1101
1102 while (cl != NULL) {
1103 RestoreLUClause(cl, pp);
1104 cl = cl->ClNext;
1105 }
1106 } else if (pp->PredFlags & MegaClausePredFlag) {
1107 MegaClause *cl = ClauseCodeToMegaClause(First);
1108
1109 RestoreMegaClause(cl);
1110 } else if (pp->PredFlags & DynamicPredFlag) {
1111 yamop *cl = First;
1112
1113 do {
1114 RestoreDynamicClause(ClauseCodeToDynamicClause(cl), pp);
1115 if (cl == Last) return;
1116 cl = NextDynamicClause(cl);
1117 } while (TRUE);
1118 } else {
1119 StaticClause *cl = ClauseCodeToStaticClause(First);
1120
1121 do {
1122 RestoreStaticClause(cl);
1123 if (cl->ClCode == Last) return;
1124 cl = cl->ClNext;
1125 } while (TRUE);
1126 }
1127 }
1128
1129
1130
1131 /* Restores a DB structure, as it was saved in the heap */
1132 static void
RestoreBB(BlackBoardEntry * pp,int int_key)1133 RestoreBB(BlackBoardEntry *pp, int int_key)
1134 {
1135 Term t = pp->Element;
1136 if (t) {
1137 if (!IsVarTerm(t)) {
1138 if (IsAtomicTerm(t)) {
1139 if (IsAtomTerm(t)) {
1140 pp->Element = AtomTermAdjust(t);
1141 }
1142 } else {
1143 RestoreLUClause((LogUpdClause *)DBRefOfTerm(t),NULL);
1144 }
1145 }
1146 }
1147 if (!int_key) {
1148 pp->KeyOfBB = AtomAdjust(pp->KeyOfBB);
1149 }
1150 if (pp->ModuleOfBB) {
1151 pp->ModuleOfBB = AtomTermAdjust(pp->ModuleOfBB);
1152 }
1153 }
1154
1155 static void
restore_static_array(StaticArrayEntry * ae)1156 restore_static_array(StaticArrayEntry *ae)
1157 {
1158 Int sz = -ae->ArrayEArity;
1159 switch (ae->ArrayType) {
1160 case array_of_ints:
1161 case array_of_doubles:
1162 case array_of_chars:
1163 case array_of_uchars:
1164 return;
1165 case array_of_ptrs:
1166 {
1167 AtomEntry **base = (AtomEntry **)AddrAdjust((ADDR)(ae->ValueOfVE.ptrs));
1168 Int i;
1169 ae->ValueOfVE.ptrs = base;
1170 if (ae != NULL) {
1171 for (i=0; i<sz; i++) {
1172 AtomEntry *reg = *base;
1173 if (reg == NULL) {
1174 base++;
1175 } else if (IsOldCode((CELL)reg)) {
1176 *base++ = AtomEntryAdjust(reg);
1177 } else if (IsOldLocalInTR((CELL)reg)) {
1178 *base++ = (AtomEntry *)LocalAddrAdjust((ADDR)reg);
1179 } else if (IsOldGlobal((CELL)reg)) {
1180 *base++ = (AtomEntry *)GlobalAddrAdjust((ADDR)reg);
1181 } else if (IsOldTrail((CELL)reg)) {
1182 *base++ = (AtomEntry *)TrailAddrAdjust((ADDR)reg);
1183 } else {
1184 /* oops */
1185 base++;
1186 }
1187 }
1188 }
1189 }
1190 return;
1191 case array_of_atoms:
1192 {
1193 Term *base = (Term *)AddrAdjust((ADDR)(ae->ValueOfVE.atoms));
1194 Int i;
1195 ae->ValueOfVE.atoms = base;
1196 if (ae != 0L) {
1197 for (i=0; i<sz; i++) {
1198 Term reg = *base;
1199 if (reg == 0L) {
1200 base++;
1201 } else {
1202 *base++ = AtomTermAdjust(reg);
1203 }
1204 }
1205 }
1206 }
1207 return;
1208 case array_of_dbrefs:
1209 {
1210 Term *base = (Term *)AddrAdjust((ADDR)(ae->ValueOfVE.dbrefs));
1211 Int i;
1212
1213 ae->ValueOfVE.dbrefs = base;
1214 if (ae != 0L) {
1215 for (i=0; i<sz; i++) {
1216 Term reg = *base;
1217 if (reg == 0L) {
1218 base++;
1219 } else {
1220 *base++ = AbsAppl(PtoHeapCellAdjust(RepAppl(reg)));
1221 }
1222 }
1223 }
1224 }
1225 return;
1226 case array_of_nb_terms:
1227 {
1228 live_term *base = (live_term *)AddrAdjust((ADDR)(ae->ValueOfVE.lterms));
1229 Int i;
1230
1231 ae->ValueOfVE.lterms = base;
1232 if (ae != 0L) {
1233 for (i=0; i < sz; i++,base++) {
1234 Term reg = base->tlive;
1235 if (IsVarTerm(reg)) {
1236 CELL *var = (CELL *)reg;
1237
1238 if (IsOldGlobalPtr(var)) {
1239 base->tlive = (CELL)PtoGloAdjust(var);
1240 } else {
1241 base->tlive = (CELL)PtoHeapCellAdjust(var);
1242 }
1243 } else if (IsAtomTerm(reg)) {
1244 base->tlive = AtomTermAdjust(reg);
1245 } else if (IsApplTerm(reg)) {
1246 CELL *db = RepAppl(reg);
1247 db = PtoGloAdjust(db);
1248 base->tlive = AbsAppl(db);
1249 } else if (IsApplTerm(reg)) {
1250 CELL *db = RepPair(reg);
1251 db = PtoGloAdjust(db);
1252 base->tlive = AbsPair(db);
1253 }
1254
1255 reg = base->tstore;
1256 if (IsVarTerm(reg)) {
1257 base->tstore = (Term)GlobalAddrAdjust((ADDR)reg);
1258 } else if (IsAtomTerm(reg)) {
1259 base->tstore = AtomTermAdjust(reg);
1260 } else {
1261 DBTerm *db = (DBTerm *)RepAppl(reg);
1262 db = DBTermAdjust(db);
1263 RestoreDBTerm(db, TRUE);
1264 base->tstore = AbsAppl((CELL *)db);
1265 }
1266 }
1267 }
1268 }
1269 case array_of_terms:
1270 {
1271 DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms));
1272 Int i;
1273
1274 ae->ValueOfVE.terms = base;
1275 if (ae != 0L) {
1276 for (i=0; i<sz; i++) {
1277 DBTerm *reg = *base;
1278 if (reg == NULL) {
1279 base++;
1280 } else {
1281 *base++ = reg = DBTermAdjust(reg);
1282 RestoreDBTerm(reg, TRUE);
1283 }
1284 }
1285 }
1286 }
1287 return;
1288 }
1289 }
1290
1291 /*
1292 * Clean all the code for a particular predicate, this can get a bit tricky,
1293 * because of the indexing code
1294 */
1295 static void
CleanCode(PredEntry * pp)1296 CleanCode(PredEntry *pp)
1297 {
1298 CELL flag;
1299
1300
1301 /* Init takes care of the first 2 cases */
1302 if (pp->ModuleOfPred) {
1303 pp->ModuleOfPred = AtomTermAdjust(pp->ModuleOfPred);
1304 }
1305 if (pp->ArityOfPE) {
1306 if (pp->ModuleOfPred == IDB_MODULE) {
1307 if (pp->PredFlags & NumberDBPredFlag) {
1308 /* it's an integer, do nothing */
1309 } else if (pp->PredFlags & AtomDBPredFlag) {
1310 pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
1311 } else {
1312 pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
1313 }
1314 } else {
1315 pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
1316 }
1317 } else {
1318 pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
1319 }
1320 if (!(pp->PredFlags & NumberDBPredFlag)) {
1321 if (pp->PredFlags & MultiFileFlag) {
1322 if (pp->src.file_srcs)
1323 pp->src.file_srcs = MFileAdjust(pp->src.file_srcs);
1324 } else {
1325 if (pp->src.OwnerFile)
1326 pp->src.OwnerFile = AtomAdjust(pp->src.OwnerFile);
1327 }
1328 }
1329 pp->OpcodeOfPred = Yap_opcode(Yap_op_from_opcode(pp->OpcodeOfPred));
1330 if (pp->NextPredOfModule) {
1331 pp->NextPredOfModule = PtoPredAdjust(pp->NextPredOfModule);
1332 }
1333 if (pp->PredFlags & (AsmPredFlag|CPredFlag)) {
1334 /* assembly */
1335 if (pp->CodeOfPred) {
1336 pp->CodeOfPred = PtoOpAdjust(pp->CodeOfPred);
1337 CleanClauses(pp->CodeOfPred, pp->CodeOfPred, pp);
1338 }
1339 } else {
1340 yamop *FirstC, *LastC;
1341 /* Prolog code */
1342 if (pp->cs.p_code.FirstClause)
1343 pp->cs.p_code.FirstClause = PtoOpAdjust(pp->cs.p_code.FirstClause);
1344 if (pp->cs.p_code.LastClause)
1345 pp->cs.p_code.LastClause = PtoOpAdjust(pp->cs.p_code.LastClause);
1346 pp->CodeOfPred =PtoOpAdjust(pp->CodeOfPred);
1347 pp->cs.p_code.TrueCodeOfPred = PtoOpAdjust(pp->cs.p_code.TrueCodeOfPred);
1348 pp->cs.p_code.ExpandCode = Yap_opcode(_expand_index);
1349 flag = pp->PredFlags;
1350 FirstC = pp->cs.p_code.FirstClause;
1351 LastC = pp->cs.p_code.LastClause;
1352 /* We just have a fail here */
1353 if (FirstC == NULL && LastC == NULL) {
1354 return;
1355 }
1356 #ifdef DEBUG_RESTORE2
1357 fprintf(stderr, "at %ux Correcting clauses from %p to %p\n", *(OPCODE *) FirstC, FirstC, LastC);
1358 #endif
1359 CleanClauses(FirstC, LastC, pp);
1360 if (flag & IndexedPredFlag) {
1361 #ifdef DEBUG_RESTORE2
1362 fprintf(stderr, "Correcting indexed code\n");
1363 #endif
1364 if (flag & LogUpdatePredFlag) {
1365 CleanLUIndex(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), TRUE);
1366 } else {
1367 CleanSIndex(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), TRUE);
1368 }
1369 } else if (flag & DynamicPredFlag) {
1370 #ifdef DEBUG_RESTORE2
1371 fprintf(stderr, "Correcting dynamic code\n");
1372 #endif
1373 RestoreDynamicClause(ClauseCodeToDynamicClause(pp->cs.p_code.TrueCodeOfPred),pp);
1374 }
1375 }
1376 /* we are pointing at ourselves */
1377 }
1378
1379 /*
1380 * Restores all of the entries, for a particular atom, we only have problems
1381 * if we find code or data bases
1382 */
1383 static void
RestoreEntries(PropEntry * pp,int int_key)1384 RestoreEntries(PropEntry *pp, int int_key)
1385 {
1386 while (!EndOfPAEntr(pp)) {
1387 switch(pp->KindOfPE) {
1388 case FunctorProperty:
1389 {
1390 FunctorEntry *fe = (FunctorEntry *)pp;
1391 Prop p0;
1392 fe->NextOfPE =
1393 PropAdjust(fe->NextOfPE);
1394 fe->NameOfFE =
1395 AtomAdjust(fe->NameOfFE);
1396 p0 = fe->PropsOfFE =
1397 PropAdjust(fe->PropsOfFE);
1398 if (!EndOfPAEntr(p0)) {
1399 /* at most one property */
1400 CleanCode(RepPredProp(p0));
1401 RepPredProp(p0)->NextOfPE =
1402 PropAdjust(RepPredProp(p0)->NextOfPE);
1403 p0 = RepPredProp(p0)->NextOfPE;
1404 }
1405 }
1406 break;
1407 case ValProperty:
1408 {
1409 ValEntry *ve = (ValEntry *)pp;
1410 Term tv = ve->ValueOfVE;
1411 ve->NextOfPE =
1412 PropAdjust(ve->NextOfPE);
1413 if (IsAtomTerm(tv))
1414 ve->ValueOfVE = AtomTermAdjust(tv);
1415 }
1416 break;
1417 case HoldProperty:
1418 {
1419 HoldEntry *he = (HoldEntry *)pp;
1420 he->NextOfPE =
1421 PropAdjust(he->NextOfPE);
1422 }
1423 break;
1424 case ArrayProperty:
1425 {
1426 ArrayEntry *ae = (ArrayEntry *)pp;
1427 ae->NextOfPE =
1428 PropAdjust(ae->NextOfPE);
1429 if (ae->ArrayEArity < 0) {
1430 /* static array entry */
1431 StaticArrayEntry *sae = (StaticArrayEntry *)ae;
1432 if (sae->NextAE)
1433 sae->NextAE = PtoArraySAdjust(sae->NextAE);
1434 restore_static_array(sae);
1435 } else {
1436 if (ae->NextAE)
1437 ae->NextAE = PtoArrayEAdjust(ae->NextAE);
1438 if (IsVarTerm(ae->ValueOfVE))
1439 RESET_VARIABLE(&(ae->ValueOfVE));
1440 else {
1441 CELL *ptr = RepAppl(ae->ValueOfVE);
1442 /* in fact it should just be a pointer to the global,
1443 but we'll be conservative.
1444 Notice that the variable should have been reset in restore_program mode.
1445 */
1446 if (IsOldGlobalPtr(ptr)) {
1447 ae->ValueOfVE = AbsAppl(PtoGloAdjust(ptr));
1448 } else if (IsOldCodeCellPtr(ptr)) {
1449 ae->ValueOfVE = AbsAppl(PtoHeapCellAdjust(ptr));
1450 } else if (IsOldLocalInTRPtr(ptr)) {
1451 ae->ValueOfVE = AbsAppl(PtoLocAdjust(ptr));
1452 } else if (IsOldTrailPtr(ptr)) {
1453 ae->ValueOfVE = AbsAppl(CellPtoTRAdjust(ptr));
1454 }
1455 }
1456 }
1457 }
1458 break;
1459 case PEProp:
1460 {
1461 PredEntry *pe = (PredEntry *) pp;
1462 pe->NextOfPE =
1463 PropAdjust(pe->NextOfPE);
1464 CleanCode(pe);
1465 }
1466 break;
1467 case DBProperty:
1468 case CodeDBProperty:
1469 #ifdef DEBUG_RESTORE2
1470 fprintf(stderr, "Correcting data base clause at %p\n", pp);
1471 #endif
1472 {
1473 DBEntry *de = (DBEntry *) pp;
1474 de->NextOfPE =
1475 PropAdjust(de->NextOfPE);
1476 RestoreDB(de);
1477 }
1478 break;
1479 case BBProperty:
1480 {
1481 BlackBoardEntry *bb = (BlackBoardEntry *) pp;
1482 bb->NextOfPE =
1483 PropAdjust(bb->NextOfPE);
1484 RestoreBB(bb, int_key);
1485 }
1486 break;
1487 case GlobalProperty:
1488 {
1489 GlobalEntry *gb = (GlobalEntry *) pp;
1490 Term gbt = gb->global;
1491
1492 gb->NextOfPE =
1493 PropAdjust(gb->NextOfPE);
1494 gb->AtomOfGE =
1495 AtomEntryAdjust(gb->AtomOfGE);
1496 if (gb->NextGE) {
1497 gb->NextGE =
1498 GlobalEntryAdjust(gb->NextGE);
1499 }
1500 if (IsVarTerm(gbt)) {
1501 CELL *gbp = VarOfTerm(gbt);
1502 if (IsOldGlobalPtr(gbp))
1503 gbp = PtoGloAdjust(gbp);
1504 else
1505 gbp = CellPtoHeapAdjust(gbp);
1506 gb->global = (CELL)gbp;
1507 } else if (IsPairTerm(gbt)) {
1508 gb->global = AbsPair(PtoGloAdjust(RepPair(gbt)));
1509 } else if (IsApplTerm(gbt)) {
1510 CELL *gbp = RepAppl(gbt);
1511 if (IsOldGlobalPtr(gbp))
1512 gbp = PtoGloAdjust(gbp);
1513 else
1514 gbp = CellPtoHeapAdjust(gbp);
1515 gb->global = AbsAppl(gbp);
1516 } else if (IsAtomTerm(gbt)) {
1517 gb->global = AtomTermAdjust(gbt);
1518 } /* numbers need no adjusting */
1519 }
1520 break;
1521 case OpProperty:
1522 {
1523 OpEntry *opp = (OpEntry *)pp;
1524 if (opp->NextOfPE) {
1525 opp->NextOfPE =
1526 PropAdjust(opp->NextOfPE);
1527 }
1528 opp->OpName =
1529 AtomAdjust(opp->OpName);
1530 if (opp->OpModule) {
1531 opp->OpModule = AtomTermAdjust(opp->OpModule);
1532 }
1533 if (opp->OpNext) {
1534 opp->OpNext = OpEntryAdjust(opp->OpNext);
1535 }
1536 }
1537 break;
1538 case ModProperty:
1539 {
1540 ModEntry *me = (ModEntry *)pp;
1541 if (me->NextOfPE) {
1542 me->NextOfPE =
1543 PropAdjust(me->NextOfPE);
1544 }
1545 if (me->PredForME) {
1546 me->PredForME =
1547 PtoPredAdjust(me->PredForME);
1548 }
1549 me->AtomOfME =
1550 AtomAdjust(me->AtomOfME);
1551 if (me->NextME)
1552 me->NextME = (struct mod_entry *)
1553 AddrAdjust((ADDR)me->NextME);
1554 }
1555 break;
1556 case ExpProperty:
1557 pp->NextOfPE =
1558 PropAdjust(pp->NextOfPE);
1559 break;
1560 case WideAtomProperty:
1561 pp->NextOfPE =
1562 PropAdjust(pp->NextOfPE);
1563 break;
1564 default:
1565 /* OOPS */
1566 Yap_Error(SYSTEM_ERROR, TermNil,
1567 "Invalid Atom Property %d at %p", pp->KindOfPE, pp);
1568 return;
1569 }
1570 pp = RepProp(pp->NextOfPE);
1571 }
1572 }
1573
1574 static void
RestoreAtom(AtomEntry * at)1575 RestoreAtom(AtomEntry *at)
1576 {
1577 AtomEntry *nat;
1578
1579 /* this should be done before testing for wide atoms */
1580 at->PropsOfAE = PropAdjust(at->PropsOfAE);
1581 #if DEBUG_RESTORE2 /* useful during debug */
1582 if (IsWideAtom(AbsAtom(at)))
1583 fprintf(errout, "Restoring %S\n", at->WStrOfAE);
1584 else
1585 fprintf(errout, "Restoring %s\n", at->StrOfAE);
1586 #endif
1587 RestoreEntries(RepProp(at->PropsOfAE), FALSE);
1588 /* cannot use AtomAdjust without breaking agc */
1589 nat = RepAtom(at->NextOfAE);
1590 if (nat)
1591 at->NextOfAE = AbsAtom(AtomEntryAdjust(nat));
1592 }
1593
1594