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