YAP 7.1.0
qlyr.c
Go to the documentation of this file.
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
8 * *
9 **************************************************************************
10 * *
11 * File: qlyr.c *
12 * comments: quick saver/loader *
13 * *
14 * Last rev: $Date: 2011-08-29$,$Author: vsc $ *
15 * $Log: not supported by cvs2svn $ *
16 * *
17 *************************************************************************/
27#include "absmi.h"
28#include "alloc.h"
29#include "attvar.h"
30#include "iopreds.h"
31#include "yapio.h"
32#include <Foreign.h>
33#if HAVE_STRING_H
34#include <string.h>
35#endif
36
37#include "qly.h"
38
39static void RestoreEntries(PropEntry *, int USES_REGS);
40static void CleanCode(PredEntry *USES_REGS);
41
42typedef enum {
43 OUT_OF_TEMP_SPACE = 0,
44 OUT_OF_ATOM_SPACE = 1,
45 OUT_OF_CODE_SPACE = 2,
46 UNKNOWN_ATOM = 3,
47 UNKNOWN_FUNCTOR = 4,
48 UNKNOWN_PRED_ENTRY = 5,
49 UNKNOWN_OPCODE = 6,
50 UNKNOWN_DBREF = 7,
51 BAD_ATOM = 8,
52 MISMATCH = 9,
53 INCONSISTENT_CPRED = 10,
54 BAD_READ = 11,
55 BAD_HEADER = 12
56} qlfr_err_t;
57
58static char *qlyr_error[] = {
59 "out of temporary space",
60 "out of temporary space",
61 "out of code space",
62 "unknown atom in saved space",
63 "unknown functor in saved space",
64 "unknown predicate in saved space",
65 "unknown YAAM opcode in saved space",
66 "unknown data-base reference in saved space",
67 "corrupted atom in saved space",
68 "formatting mismatch in saved space",
69 "foreign predicate has different definition in saved space",
70 "bad read"};
71
72static char *Yap_AlwaysAllocCodeSpace(UInt size) {
73 char *out;
74 while (!(out = Yap_AllocCodeSpace(size))) {
75 if (!Yap_growheap(FALSE, size, NULL)) {
76 return NULL;
77 }
78 }
79 return out;
80}
81
82
83#define QLYR_ERROR(err) \
84 QLYR_ERROR__(__FILE__, __FUNCTION__, __LINE__, err)
85
86
87
88static void QLYR_ERROR__(const char *file, const char *function, int lineno,
89 qlfr_err_t my_err) {
90 // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state
91 // %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
92 Yap_Error__(false, file, function, lineno, SYSTEM_ERROR_SAVED_STATE, TermNil, "error %s in saved state %s",
93 GLOBAL_RestoreFile, qlyr_error[my_err]);
94 Yap_exit(1);
95}
96
97static Atom LookupAtom(Atom oat) {
98 CACHE_REGS
99 CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
101
102 a = LOCAL_ImportAtomHashChain[hash];
103 while (a) {
104 if (a->oval == oat) {
105 return a->val;
106 }
107 a = a->next;
108 }
109 // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ",
110 // oat);
111 QLYR_ERROR(UNKNOWN_ATOM);
112 return NIL;
113}
114
115static void InsertAtom(Atom oat, Atom at) {
116 CACHE_REGS
117 CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
119
120 a = LOCAL_ImportAtomHashChain[hash];
121 while (a) {
122 if (a->oval == oat) {
123 return;
124 }
125 a = a->next;
126 }
128 if (!a) {
129 return;
130 }
131 a->val = at;
132 a->oval = oat;
133 a->next = LOCAL_ImportAtomHashChain[hash];
134 LOCAL_ImportAtomHashChain[hash] = a;
135}
136
137static Functor LookupFunctor(Functor ofun) {
138 CACHE_REGS
139 CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize;
141
142 f = LOCAL_ImportFunctorHashChain[hash];
143 while (f) {
144 if (f->oval == ofun) {
145 return f->val;
146 }
147 f = f->next;
148 }
149 QLYR_ERROR(UNKNOWN_FUNCTOR);
150 return NIL;
151}
152
153static void InsertFunctor(Functor ofun, Functor fun) {
154 CACHE_REGS
155 CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize;
157
158 f = LOCAL_ImportFunctorHashChain[hash];
159 while (f) {
160 if (f->oval == ofun) {
161 return;
162 }
163 f = f->next;
164 }
165 f = (import_functor_hash_entry_t *)malloc(
167 if (!f) {
168 return;
169 }
170 f->val = fun;
171 f->oval = ofun;
172 f->next = LOCAL_ImportFunctorHashChain[hash];
173 LOCAL_ImportFunctorHashChain[hash] = f;
174}
175
176static PredEntry *LookupPredEntry(PredEntry *op) {
177 CACHE_REGS
178 CELL hash;
180
181 if (LOCAL_ImportPredEntryHashTableSize == 0)
182 return NULL;
183 hash = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
184 p = LOCAL_ImportPredEntryHashChain[hash];
185 while (p) {
186 if (p->oval == op) {
187 return p->val;
188 }
189 p = p->next;
190 }
191 QLYR_ERROR(UNKNOWN_PRED_ENTRY);
192 return NIL;
193}
194
195static void InsertPredEntry(PredEntry *op, PredEntry *pe) {
196 CACHE_REGS
197 CELL hash;
199
200 if (LOCAL_ImportPredEntryHashTableSize == 0)
201 return;
202 hash = (CELL)(op) % LOCAL_ImportPredEntryHashTableSize;
203 p = LOCAL_ImportPredEntryHashChain[hash];
204 while (p) {
205 if (p->oval == op) {
206 return;
207 }
208 p = p->next;
209 }
210 p = (import_pred_entry_hash_entry_t *)malloc(
212 if (!p) {
213 return;
214 }
215 p->val = pe;
216 p->oval = op;
217 p->next = LOCAL_ImportPredEntryHashChain[hash];
218 LOCAL_ImportPredEntryHashChain[hash] = p;
219}
220
221static OPCODE LookupOPCODE(OPCODE op) {
222 CACHE_REGS
223 CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
225
226 f = LOCAL_ImportOPCODEHashChain[hash];
227 while (f) {
228 if (f->oval == op) {
229 return f->val;
230 }
231 f = f->next;
232 }
233 QLYR_ERROR(UNKNOWN_OPCODE);
234 return NIL;
235}
236
237static int OpcodeID(OPCODE op) {
238 CACHE_REGS
239 CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
241
242 f = LOCAL_ImportOPCODEHashChain[hash];
243 while (f) {
244 if (f->oval == op) {
245 return f->id;
246 }
247 f = f->next;
248 }
249 QLYR_ERROR(UNKNOWN_OPCODE);
250 return NIL;
251}
252
253static void InsertOPCODE(OPCODE op0, int i, OPCODE op) {
254 CACHE_REGS
255 CELL hash = (CELL)(op0) % LOCAL_ImportOPCODEHashTableSize;
257 f = LOCAL_ImportOPCODEHashChain[hash];
258 while (f) {
259 if (f->oval == op0) {
260 return;
261 }
262 f = f->next;
263 }
265 if (!f) {
266 return;
267 }
268 f->val = op;
269 f->oval = op0;
270 f->id = i;
271 f->next = LOCAL_ImportOPCODEHashChain[hash];
272 LOCAL_ImportOPCODEHashChain[hash] = f;
273}
274
275static DBRef LookupDBRef(DBRef dbr, int inc_ref) {
276 CACHE_REGS
277 CELL hash;
279
280 if (LOCAL_ImportDBRefHashTableSize == 0)
281 return NULL;
282 hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
283 p = LOCAL_ImportDBRefHashChain[hash];
284 while (p) {
285 if (p->oval == dbr) {
286 if (inc_ref) {
287 p->count++;
288 }
289 return p->val;
290 }
291 p = p->next;
292 }
293 QLYR_ERROR(UNKNOWN_DBREF);
294 return NIL;
295}
296
297static LogUpdClause *LookupMayFailDBRef(DBRef dbr) {
298 CACHE_REGS
299 CELL hash;
301
302 if (LOCAL_ImportDBRefHashTableSize == 0)
303 return NULL;
304 hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
305 p = LOCAL_ImportDBRefHashChain[hash];
306 while (p) {
307 if (p->oval == dbr) {
308 p->count++;
309 return (LogUpdClause *)p->val;
310 }
311 p = p->next;
312 }
313 return NULL;
314}
315
316static void InsertDBRef(DBRef dbr0, DBRef dbr) {
317 CACHE_REGS
318 CELL hash = (CELL)(dbr0) % LOCAL_ImportDBRefHashTableSize;
320
321 p = LOCAL_ImportDBRefHashChain[hash];
322 while (p) {
323 if (p->oval == dbr0) {
324 return;
325 }
326 p = p->next;
327 }
329 if (!p) {
330 return;
331 }
332 p->val = dbr;
333 p->oval = dbr0;
334 p->count = 0;
335 p->next = LOCAL_ImportDBRefHashChain[hash];
336 LOCAL_ImportDBRefHashChain[hash] = p;
337}
338
339static void InitHash(void) {
340 CACHE_REGS
341 LOCAL_ImportOPCODEHashTableSize = EXPORT_OPCODE_TABLE_SIZE;
342 LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc(
343 1,
344 sizeof(import_opcode_hash_entry_t *) * LOCAL_ImportOPCODEHashTableSize);
345}
346
347static void CloseHash(void) {
348 CACHE_REGS
349 UInt i;
350 for (i = 0; i < LOCAL_ImportFunctorHashTableSize; i++) {
351 import_functor_hash_entry_t *a = LOCAL_ImportFunctorHashChain[i];
352 while (a) {
354 a = a->next;
355 free(a0);
356 }
357 }
358 LOCAL_ImportFunctorHashTableSize = 0;
359 free(LOCAL_ImportFunctorHashChain);
360 LOCAL_ImportFunctorHashChain = NULL;
361 for (i = 0; i < LOCAL_ImportAtomHashTableSize; i++) {
362 import_atom_hash_entry_t *a = LOCAL_ImportAtomHashChain[i];
363 while (a) {
365 a = a->next;
366 free(a0);
367 }
368 }
369 LOCAL_ImportAtomHashTableSize = 0;
370 free(LOCAL_ImportAtomHashChain);
371 LOCAL_ImportAtomHashChain = NULL;
372 for (i = 0; i < LOCAL_ImportOPCODEHashTableSize; i++) {
373 import_opcode_hash_entry_t *a = LOCAL_ImportOPCODEHashChain[i];
374 while (a) {
376 a = a->next;
377 free(a0);
378 }
379 }
380 LOCAL_ImportOPCODEHashTableSize = 0;
381 free(LOCAL_ImportOPCODEHashChain);
382 LOCAL_ImportOPCODEHashChain = NULL;
383 for (i = 0; i < LOCAL_ImportPredEntryHashTableSize; i++) {
384 import_pred_entry_hash_entry_t *a = LOCAL_ImportPredEntryHashChain[i];
385 while (a) {
387 a = a->next;
388 free(a0);
389 }
390 }
391 LOCAL_ImportPredEntryHashTableSize = 0;
392 free(LOCAL_ImportPredEntryHashChain);
393 LOCAL_ImportPredEntryHashChain = NULL;
394 for (i = 0; i < LOCAL_ImportDBRefHashTableSize; i++) {
395 import_dbref_hash_entry_t *a = LOCAL_ImportDBRefHashChain[i];
396 while (a) {
398#ifdef DEBUG
399 if (!a->count) {
400 fprintf(stderr, "WARNING: unused reference %p %p\n", a->val, a->oval);
401 }
402#endif
403 a = a->next;
404 free(a0);
405 }
406 }
407 LOCAL_ImportDBRefHashTableSize = 0;
408 free(LOCAL_ImportDBRefHashChain);
409 LOCAL_ImportDBRefHashChain = NULL;
410}
411
412static inline Atom AtomAdjust(Atom a) { return LookupAtom(a); }
413
414static inline Functor FuncAdjust(Functor f) {
415 return LookupFunctor(f);
416 return f;
417}
418
419static inline Term AtomTermAdjust(Term t) {
420 return MkAtomTerm(LookupAtom(AtomOfTerm(t)));
421}
422
423static inline Term TermToGlobalOrAtomAdjust(Term t) {
424 if (t && IsAtomTerm(t))
425 return AtomTermAdjust(t);
426 return t;
427}
428
429#define IsOldCode(P) FALSE
430#define IsOldCodeCellPtr(P) FALSE
431#define IsOldDelay(P) FALSE
432#define IsOldDelayPtr(P) FALSE
433#define IsOldLocalInTR(P) FALSE
434#define IsOldLocalInTRPtr(P) FALSE
435#define IsOldGlobal(P) FALSE
436#define IsOldGlobalPtr(P) FALSE
437#define IsOldTrail(P) FALSE
438#define IsOldTrailPtr(P) FALSE
439
440#define CharP(X) ((char *)(X))
441
442#define REINIT_LOCK(P)
443#define REINIT_RWLOCK(P)
444#define BlobTypeAdjust(P) (P)
445#define NoAGCAtomAdjust(P) (P)
446#define OrArgAdjust(P)
447#define TabEntryAdjust(P)
448#define IntegerAdjust(D) (D)
449#define AddrAdjust(P) (P)
450#define MFileAdjust(P) (P)
451
452#define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS)
453static inline Term CodeVarAdjust__(Term var USES_REGS) {
454 if (var == 0L)
455 return var;
456 return (Term)(CharP(var) + LOCAL_HDiff);
457}
458
459#define ConstantAdjust(P) (P)
460#define ArityAdjust(P) (P)
461#define DoubleInCodeAdjust(P)
462#define IntegerInCodeAdjust(Pxb)
463
464static inline PredEntry *PtoPredAdjust(PredEntry *p) {
465 return LookupPredEntry(p);
466}
467
468static inline PredEntry *PredEntryAdjust(PredEntry *p) {
469 return LookupPredEntry(p);
470}
471
472static inline OPCODE OpcodeAdjust(OPCODE OP) { return LookupOPCODE(OP); }
473
474static inline Term ModuleAdjust(Term M) {
475 if (!M)
476 return M;
477 return AtomTermAdjust(M);
478}
479
480#define ExternalFunctionAdjust(P) (P)
481#define DBRecordAdjust(P) (P)
482#define ModEntryPtrAdjust(P) (P)
483#define AtomEntryAdjust(P) (P)
484#define GlobalEntryAdjust(P) (P)
485#define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS)
486#if TAGS_FAST_OPS
487static inline Term BlobTermInCodeAdjust__(Term t USES_REGS) {
488 return (Term)((char *)(t)-LOCAL_HDiff);
489}
490#else
491static inline Term BlobTermInCodeAdjust__(Term t USES_REGS) {
492 return (Term)((char *)(t) + LOCAL_HDiff);
493}
494#endif
495#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS)
496static inline DBTerm *DBTermAdjust__(DBTerm *dbtp USES_REGS) {
497 return (DBTerm *)(CharP(dbtp) + LOCAL_HDiff);
498}
499
500#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS)
501static inline CELL *CellPtoHeapAdjust__(CELL *dbtp USES_REGS) {
502 return (CELL *)(CharP(dbtp) + LOCAL_HDiff);
503}
504
505#define PtoAtomHashEntryAdjust(P) (P)
506#define CellPtoHeapCellAdjust(P) (P)
507#define CellPtoTRAdjust(P) (P)
508#define CodeAddrAdjust(P) (P)
509#define ConsultObjAdjust(P) (P)
510#define DelayAddrAdjust(P) (P)
511#define DelayAdjust(P) (P)
512#define GlobalAdjust(P) (P)
513
514#define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS)
515static inline DBRef DBRefAdjust__(DBRef dbtp, int do_reference USES_REGS) {
516 return LookupDBRef(dbtp, do_reference);
517}
518
519#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)
520static inline DBRef *DBRefPAdjust__(DBRef *dbtp USES_REGS) {
521 return (DBRef *)((char *)(dbtp) + LOCAL_HDiff);
522}
523
524#define LUIndexAdjust(P) (P)
525#define SIndexAdjust(P) (P)
526#define LocalAddrAdjust(P) (P)
527#define GlobalAddrAdjust(P) (P)
528#define OpListAdjust(P) (P)
529
530#define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS)
531#define PtoLUClauseAdjust(P) PtoLUCAdjust__(P PASS_REGS)
532static inline LogUpdClause *PtoLUCAdjust__(LogUpdClause *dbtp USES_REGS) {
533 return (LogUpdClause *)((char *)(dbtp) + LOCAL_HDiff);
534}
535
536#define PtoStCAdjust(P) (P)
537#define PtoArrayEAdjust(P) (P)
538#define PtoArraySAdjust(P) (P)
539#define PtoGlobalEAdjust(P) (P)
540#define PtoDelayAdjust(P) (P)
541#define PtoGloAdjust(P) (P)
542#define PtoLocAdjust(P) (P)
543
544#define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS)
545static inline CELL *PtoHeapCellAdjust__(CELL *ptr USES_REGS) {
546 LogUpdClause *out;
547 if ((out = LookupMayFailDBRef((DBRef)ptr)))
548 return (CELL *)out;
549 return (CELL *)(CharP(ptr) + LOCAL_HDiff);
550}
551
552#define TermToGlobalAdjust(P) (P)
553#define PtoOpAdjust(P) PtoOpAdjust__(P PASS_REGS)
554static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) {
555 if (ptr) {
556 if (ptr == LOCAL_ImportFAILCODE)
557 return FAILCODE;
558 return (yamop *)((char *)(ptr) + LOCAL_HDiff);
559 }
560 return ptr;
561}
562#define PtoLUIndexAdjust(P) (P)
563#define PtoDBTLAdjust(P) (P)
564#define PtoPtoPredAdjust(P) (P)
565#define OpRTableAdjust(P) (P)
566#define OpEntryAdjust(P) (P)
567#define PropAdjust(P) (P)
568#define TrailAddrAdjust(P) (P)
569#if PRECOMPUTE_REGADDRESS
570#define XAdjust(P) XAdjust__(P PASS_REGS)
571static inline wamreg XAdjust__(wamreg reg USES_REGS) {
572 return (wamreg)((wamreg)((reg) + LOCAL_XDiff));
573}
574#else
575#define XAdjust(X) (X)
576#endif
577#define YAdjust(X) (X)
578#define HoldEntryAdjust(P) (P)
579#define CodeCharPAdjust(P) (P)
580#define CodeConstCharPAdjust(P) (P)
581#define CodeVoidPAdjust(P) (P)
582#define HaltHookAdjust(P) (P)
583
584#define recompute_mask(dbr)
585
586#define rehash(oldcode, NOfE, KindOfEntries)
587
588#define RestoreSWIHash()
589
590#define Yap_op_from_opcode(OP) OpcodeID(OP)
591
592static void RestoreFlags(UInt NFlags) {}
593
594#include "rheap.h"
595
596static void RestoreHashPreds(USES_REGS1) {}
597
598static void RestoreAtomList(Atom atm USES_REGS) {}
599
600static bool maybe_read_bytes(FILE *stream, void *ptr, size_t sz) {
601 do {
602 size_t count;
603 if ((count = fread(ptr, 1, sz, stream)) == sz)
604 return true;
605 if (feof(stream) || ferror(stream))
606 return false;
607 sz -= count;
608 ptr += count;
609 } while (true);
610}
611
612static size_t read_bytes(FILE *stream, void *ptr, size_t sz) {
613 do {
614 size_t count = fread(ptr, 1, sz, stream);
615 if (count == sz)
616 return sz;
617 if (feof(stream)) {
618 PlIOError(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, TermNil, "read_qly/3: expected %ld bytes got %ld", sz, count);
619 return 0;
620 } else if (ferror(stream)) {
621 PlIOError(PERMISSION_ERROR_INPUT_STREAM, TermNil, "read_qly/3: expected %ld bytes got error %s", sz, strerror(errno));
622 return 0;
623 }
624 sz -= count;
625 } while(true);
626}
627
628static unsigned char read_byte(FILE *stream) { return getc(stream); }
629
630static BITS16 read_bits16(FILE *stream) {
631 BITS16 v;
632 read_bytes(stream, &v, sizeof(BITS16));
633 return v;
634}
635
636static UInt read_UInt(FILE *stream) {
637 UInt v;
638 read_bytes(stream, &v, sizeof(UInt));
639 return v;
640}
641
642static Int read_Int(FILE *stream) {
643 Int v;
644 read_bytes(stream, &v, sizeof(Int));
645 return v;
646}
647
648static qlf_tag_t read_tag(FILE *stream) {
649 int ch = read_byte(stream);
650 return ch;
651}
652
653static pred_flags_t read_predFlags(FILE *stream) {
654 pred_flags_t v;
655 read_bytes(stream, &v, sizeof(pred_flags_t));
656 return v;
657}
658
659
660static Atom do_header(FILE *stream) {
661 char s[2049], *p = s, *q;
662 char h0[] = "#!/bin/sh\nexec_dir=${YAPBINDIR:-";
663 char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved ";
664 Atom at;
665
666 memset(s,0,2049);
667 if (!maybe_read_bytes( stream, s, 2048) )
668 return NIL;
669 if (strstr(s, h0)!= s)
670 return NIL;
671 if ((p=strstr(s, h1)) == NULL) {
672 return NIL;
673 }
674 p += strlen(h1);
675 q = strchr(p,',');
676 if (!q)
677 return NIL;
678 q[0] = '\0';
679 at = Yap_LookupAtom(p);
680 return at;
681}
682
683static Int get_header(USES_REGS1) {
684 FILE *stream;
685 Term t1 = Deref(ARG1);
686 Atom at;
687 Int rc;
688
689 if (IsVarTerm(t1)) {
690 Yap_Error(INSTANTIATION_ERROR, t1, "read_program/3");
691 return FALSE;
692 }
693 if (!(stream = Yap_GetInputStream(t1, "header scanning in qload"))) {
694 return false;
695 }
696 sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
697 LOCAL_RestartEnv = &signew;
698
699 if (sigsetjmp(signew, 1) != 0) {
700 LOCAL_RestartEnv = sighold;
701 return false;
702 }
703 if ((at = do_header(stream)) == NIL)
704 rc = false;
705 else {
706 rc = Yap_unify(ARG2, MkAtomTerm(at));
707 }
708 LOCAL_RestartEnv = sighold;
709 return rc;
710}
711
712static void ReadHash(FILE *stream) {
713 CACHE_REGS
714 UInt i;
715 RCHECK(read_tag(stream) == QLY_START_X);
716 LOCAL_XDiff = (char *)(&ARG1) - (char *)read_UInt(stream);
717 RCHECK(read_tag(stream) == QLY_START_OPCODES);
718 RCHECK(read_Int(stream) == _std_top);
719 for (i = 0; i <= _std_top; i++) {
720 InsertOPCODE((OPCODE)read_UInt(stream), i, Yap_opcode(i));
721 }
722 RCHECK(read_tag(stream) == QLY_START_ATOMS);
723 LOCAL_ImportAtomHashTableNum = read_UInt(stream);
724 LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum * 2;
725 LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(
726 LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *));
727 for (i = 0; i < LOCAL_ImportAtomHashTableNum; i++) {
728 Atom oat = (Atom)read_UInt(stream);
729 Atom at;
730 qlf_tag_t tg = read_tag(stream);
731
732 if (tg == QLY_ATOM) {
733 char *rep = (char *)AllocTempSpace();
734 UInt len;
735
736 len = read_UInt(stream);
737 if (!EnoughTempSpace(len))
738 QLYR_ERROR(OUT_OF_TEMP_SPACE);
739 read_bytes(stream, rep, (len + 1) * sizeof(char));
740 while (!(at = Yap_FullLookupAtom(rep))) {
741 if (!Yap_growheap(FALSE, 0, NULL)) {
742 exit(1);
743 }
744 }
745 if (at == NIL)
746 QLYR_ERROR(OUT_OF_ATOM_SPACE);
747 } else {
748 QLYR_ERROR(BAD_ATOM);
749 return;
750 }
751 InsertAtom(oat, at);
752 }
753 /* functors */
754 RCHECK(read_tag(stream) == QLY_START_FUNCTORS);
755 LOCAL_ImportFunctorHashTableNum = read_UInt(stream);
756 LOCAL_ImportFunctorHashTableSize = 2 * LOCAL_ImportFunctorHashTableNum;
757 LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(
758 LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *));
759 for (i = 0; i < LOCAL_ImportFunctorHashTableNum; i++) {
760 Functor of = (Functor)read_UInt(stream);
761 UInt arity = read_UInt(stream);
762 Atom oat = (Atom)read_UInt(stream);
763 Atom at = AtomAdjust(oat);
764 Functor f;
765 while (!(f = Yap_MkFunctor(at, arity))) {
766 if (!Yap_growheap(FALSE, 0, NULL)) {
767 exit(1);
768 }
769 }
770 InsertFunctor(of, f);
771 }
772 RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES);
773 LOCAL_ImportPredEntryHashTableNum = read_UInt(stream);
774 LOCAL_ImportPredEntryHashTableSize = 2 * LOCAL_ImportPredEntryHashTableNum;
775 LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc(
776 LOCAL_ImportPredEntryHashTableSize,
778 for (i = 0; i < LOCAL_ImportPredEntryHashTableNum; i++) {
779 PredEntry *ope = (PredEntry *)read_UInt(stream), *pe;
780 UInt arity = read_UInt(stream);
781 Atom omod = (Atom)read_UInt(stream);
782 Term mod;
783
784 if (omod) {
785 mod = MkAtomTerm(AtomAdjust(omod));
786 if (mod == TermProlog)
787 mod = 0;
788 } else {
789 mod = TermProlog;
790 }
791
792 if (mod != IDB_MODULE) {
793 if (arity) {
794 Functor of = (Functor)read_UInt(stream);
795 Functor f = LookupFunctor(of);
796 while (!(pe = RepPredProp(PredPropByFuncAndMod(f, mod)))) {
797 if (!Yap_growheap(FALSE, 0, NULL)) {
798 exit(1);
799 }
800 }
801 } else {
802 Atom oa = (Atom)read_UInt(stream);
803 Atom a = LookupAtom(oa);
804 pe = RepPredProp(PredPropByAtomAndMod(a, mod));
805 }
806 } else {
807 /* IDB */
808 if (arity == (UInt)-1) {
809 UInt i = read_UInt(stream);
810 pe = Yap_FindLUIntKey(i);
811 } else if (arity == (UInt)(-2)) {
812 Atom oa = (Atom)read_UInt(stream);
813 Atom a = LookupAtom(oa);
814 pe = RepPredProp(PredPropByAtomAndMod(a, mod));
815 pe->PredFlags |= AtomDBPredFlag;
816 } else {
817 Functor of = (Functor)read_UInt(stream);
818 Functor f = LookupFunctor(of);
819 pe = RepPredProp(PredPropByFuncAndMod(f, mod));
820 }
821 pe->PredFlags |= LogUpdatePredFlag;
822 pe->ArityOfPE = 3;
823 if (pe->OpcodeOfPred == UNDEF_OPCODE) {
824 pe->OpcodeOfPred = Yap_opcode(_op_fail);
825 pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
826 }
827 }
828 InsertPredEntry(ope, pe);
829 }
830 RCHECK(read_tag(stream) == QLY_START_DBREFS);
831 LOCAL_ImportDBRefHashTableNum = read_UInt(stream);
832 LOCAL_ImportDBRefHashTableSize = 2 * LOCAL_ImportDBRefHashTableNum + 17;
833 LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(
834 LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *));
835 for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) {
836 LogUpdClause *ocl = (LogUpdClause *)read_UInt(stream);
837 UInt sz = read_UInt(stream);
838 UInt nrefs = read_UInt(stream);
839 LogUpdClause *ncl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(sz);
840 Yap_LUClauseSpace += sz;
841 if (!ncl) {
842 QLYR_ERROR(OUT_OF_CODE_SPACE);
843 }
844 ncl->Id = FunctorDBRef;
845 ncl->ClRefCount = nrefs;
846 InsertDBRef((DBRef)ocl, (DBRef)ncl);
847 }
848 RCHECK(read_tag(stream) == QLY_FAILCODE);
849 LOCAL_ImportFAILCODE = (yamop *)read_UInt(stream);
850}
851
852static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
853 pred_flags_t flags) {
854 CACHE_REGS
855 if (flags & LogUpdatePredFlag) {
856 /* first, clean up whatever was there */
857 while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
858 char *base = (void *)read_UInt(stream);
859 UInt size = read_UInt(stream);
860 LogUpdClause *cl;
861 Int nrefs = 0;
862
863 if ((cl = LookupMayFailDBRef((DBRef)base))) {
864 nrefs = cl->ClRefCount;
865 } else {
866 cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size);
867 Yap_LUClauseSpace += size;
868 }
869 read_bytes(stream, cl, size);
870 cl->ClFlags &= ~InUseMask;
871 cl->ClRefCount = nrefs;
872 LOCAL_HDiff = (char *)cl - base;
873 RestoreLUClause(cl, pp PASS_REGS);
874 Yap_AssertzClause(pp, cl->ClCode);
875 }
876 } else if (flags & MegaClausePredFlag) {
877 CACHE_REGS
878 char *base = (void *)read_UInt(stream);
879 UInt mask = read_UInt(stream);
880 UInt size = read_UInt(stream);
881 Yap_ClauseSpace += size;
882 MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);
883
884 if (nclauses) {
885 Yap_Abolish(pp);
886 }
887 LOCAL_HDiff = (char *)cl - base;
888 read_bytes(stream, cl, size);
889 cl->ClFlags = mask;
890 pp->cs.p_code.FirstClause = pp->cs.p_code.LastClause = cl->ClCode;
891 pp->PredFlags |= MegaClausePredFlag;
892 /* enter index mode */
893 if (mask & ExoMask) {
894 struct index_t **icl = (struct index_t **)(cl->ClCode);
895 pp->OpcodeOfPred = Yap_opcode(_enter_exo);
896 icl[0] = NULL;
897 icl[1] = NULL;
898 } else {
899 pp->OpcodeOfPred = INDEX_OPCODE;
900 }
901 pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred =
902 (yamop *)(&(pp->OpcodeOfPred));
903 /* This must be set for restoremegaclause */
904 pp->cs.p_code.NOfClauses = nclauses;
905 RestoreMegaClause(cl PASS_REGS);
906 } else if (flags & DynamicPredFlag) {
907 UInt i;
908
909 for (i = 0; i < nclauses; i++) {
910 char *base = (void *)read_UInt(stream);
911 UInt size = read_UInt(stream);
912 DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size);
913 Yap_LUClauseSpace += size;
914
915 LOCAL_HDiff = (char *)cl - base;
916 read_bytes(stream, cl, size);
917 INIT_LOCK(cl->ClLock);
918 RestoreDynamicClause(cl, pp PASS_REGS);
919 Yap_AssertzClause(pp, cl->ClCode);
920 }
921
922 } else {
923 UInt i;
924
925 if (flags & SYSTEM_PRED_FLAGS) {
926 if (nclauses) {
927 QLYR_ERROR(INCONSISTENT_CPRED);
928 }
929 return;
930 }
931 if (pp->cs.p_code.NOfClauses) {
932 StaticClause *cl;
933 cl = ClauseCodeToStaticClause(pp->cs.p_code.FirstClause);
934 do {
935 StaticClause *ncl = cl->ClNext;
936 Yap_EraseStaticClause(cl, pp, CurrentModule);
937 cl = ncl;
938 } while (cl != NULL);
939 } else if (flags & MultiFileFlag) {
940 pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
941 pp->OpcodeOfPred = FAIL_OPCODE;
942
943 }
944 for (i = 0; i < nclauses; i++) {
945 char *base = (void *)read_UInt(stream);
946 UInt size = read_UInt(stream);
947 StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size);
948 Yap_ClauseSpace += size;
949
950 LOCAL_HDiff = (char *)cl - base;
951 read_bytes(stream, cl, size);
952 RestoreStaticClause(cl PASS_REGS);
953 Yap_AssertzClause(pp, cl->ClCode);
954 }
955 }
956}
957
958static void read_pred(FILE *stream, Term mod) {
959 pred_flags_t flags;
960 UInt nclauses;
961 PredEntry *ap;
962
963 ap = LookupPredEntry((PredEntry *)read_UInt(stream));
964 flags = read_predFlags(stream);
965 // fprintf(stderr, "next %lx-%lx %lx: ", ap->PredFlags, flags, flags & ForeignPredFlags); (Yap_DebugWriteIndicator(ap));
966 #if 0
967 if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
968 // __android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags);
969 // printf(" %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags);
970 else if (ap->ModuleOfPred != IDB_MODULE)
971 //__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags);
972 printf(" %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags);
973 //else
974 // __android_log_print(ANDROID_LOG_INFO, "YAP "," number\n");
975#endif
976if (flags & ForeignPredFlags) {
977 if (!(ap->PredFlags & (ForeignPredFlags))) {
978 fprintf(stderr, "C-predicate does not exist in new engine: ");
979 Yap_DebugWriteIndicator(ap);
980
981 QLYR_ERROR(INCONSISTENT_CPRED);
982 }
983 if (flags & MetaPredFlag)
984 ap->PredFlags |= MetaPredFlag;
985 return;
986 }
987 nclauses = read_UInt(stream);
988 if (ap->PredFlags & IndexedPredFlag) {
989 Yap_RemoveIndexation(ap);
990 }
991 if (ap->PredFlags & LogUpdatePredFlag) {
992 if (ap->cs.p_code.NOfClauses) {
993 LogUpdClause *cl;
994 cl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause);
995 do {
996 LogUpdClause *ncl = cl->ClNext;
997 Yap_ErLogUpdCl(cl);
998 cl = ncl;
999 } while (cl != NULL);
1000 }
1001 }
1002// fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
1003 // ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
1004 ap->PredFlags = flags & ~StatePredFlags;
1005 if (nclauses && (ap->PredFlags & UndefPredFlag)) {
1006 ap->PredFlags &= ~UndefPredFlag;
1007 }
1008 if (flags & NumberDBPredFlag) {
1009 ap->src.IndxId = read_UInt(stream);
1010 } else {
1011 ap->src.OwnerFile = (Atom)read_UInt(stream);
1012
1013 if (ap->src.OwnerFile) {
1014 ap->src.OwnerFile = AtomAdjust(ap->src.OwnerFile);
1015 }
1016 }
1017 ap->TimeStampOfPred = read_UInt(stream);
1018 /* multifile predicates cannot reside in module 0 */
1019 // if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE) {
1020 // ap->ModuleOfPred = TermProlog;
1021 // }
1022 if (flags & ( MultiFileFlag|LogUpdatePredFlag)) {
1023 ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = FAILCODE;
1024 ap->OpcodeOfPred = FAIL_OPCODE;
1025 ap->cs.p_code.NOfClauses = 0;
1026}
1027 if (nclauses && !(ap->PredFlags & ForeignPredFlags))
1028 read_clauses(stream, ap, nclauses, flags);
1029#if DEBUG
1030// Yap_PrintPredName( ap );
1031#endif
1032
1033 if (flags & HiddenPredFlag) {
1034 Yap_HidePred(ap);
1035 }
1036}
1037
1038static void read_ops(FILE *stream) {
1039 Int x;
1040 while ((x = read_tag(stream)) != QLY_END_OPS) {
1041 Atom at = (Atom)read_UInt(stream);
1042 Term mod = (Term)read_UInt(stream);
1043 OpEntry *op;
1044
1045 at = AtomAdjust(at);
1046 if (mod)
1047 mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
1048 op = Yap_OpPropForModule(at, mod);
1049 op->Prefix = read_bits16(stream);
1050 op->Infix = read_bits16(stream);
1051 op->Posfix = read_bits16(stream);
1052 WRITE_UNLOCK(op->OpRWLock);
1053 }
1054}
1055
1056static void read_module(FILE *stream) {
1057 qlf_tag_t x;
1058
1059 InitHash();
1060 ReadHash(stream);
1061 while ((x = read_tag(stream)) == QLY_START_MODULE) {
1062 Term mod = (Term)read_UInt(stream);
1063 if (mod == 0)
1064 mod = TermProlog;
1065 mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod)));
1066 if (mod)
1067 while ((x = read_tag(stream)) == QLY_START_PREDICATE) {
1068 read_pred(stream, mod);
1069 }
1070 }
1071 read_ops(stream);
1072 CloseHash();
1073}
1074
1075static Int p_read_module_preds(USES_REGS1) {
1076 FILE *stream;
1077 Term t1 = Deref(ARG1);
1078
1079 if (IsVarTerm(t1)) {
1080 Yap_Error(INSTANTIATION_ERROR, t1, "read_qly/3");
1081 return FALSE;
1082 }
1083 if (!IsAtomTerm(t1)) {
1084 Yap_Error(TYPE_ERROR_ATOM, t1, "read_qly/3");
1085 return (FALSE);
1086 }
1087 if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules"))) {
1088 return FALSE;
1089 }
1090 read_module(stream);
1091 return TRUE;
1092}
1093
1094static void ReInitProlog(void) {
1095 Term t = MkAtomTerm(AtomInitProlog);
1096 YAP_RunGoalOnce(t);
1097}
1098
1099static Int qload_program(USES_REGS1) {
1100 FILE *stream;
1101
1102
1103 Term t1 = Deref(ARG1);
1104
1105 if (IsVarTerm(t1)) {
1106 Yap_Error(INSTANTIATION_ERROR, t1, "read_program/3");
1107 return FALSE;
1108 }
1109 if ((stream = Yap_GetInputStream(t1, "from read_program"))) {
1110 return FALSE;
1111 }
1112 Yap_Reset(YAP_RESET_FROM_RESTORE, true);
1113 if (do_header(stream) == NIL)
1114 return FALSE;
1115 read_module(stream);
1116 fclose(stream);
1117 /* back to the top level we go */
1118 ReInitProlog();
1119 return true;
1120}
1121
1122YAP_file_type_t Yap_Restore(const char *s) {
1123 CACHE_REGS
1124
1125 int lvl = push_text_stack();
1126 const char *tmp = Yap_AbsoluteFile(s, true);
1127
1128 FILE *stream = Yap_OpenRestore(tmp);
1129 if (!stream)
1130 return -1;
1131#define BUFSIX 4096*256
1132 char *buf = malloc(BUFSIZ);
1133 setvbuf(stream, buf, buf ? _IOFBF : _IONBF, BUFSIZ);
1134 GLOBAL_RestoreFile = s;
1135 if (do_header(stream) == NIL) {
1136 pop_text_stack(lvl);
1137 return YAP_PL;
1138 }
1139 read_module(stream);
1140 setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
1141 fclose(stream);
1142 free(buf);
1143 GLOBAL_RestoreFile = NULL;
1144 LOCAL_SourceModule = CurrentModule = USER_MODULE;
1145 pop_text_stack(lvl);
1146 return YAP_QLY;
1147}
1148
1149void Yap_InitQLYR(void) {
1150 Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds,
1151 SyncPredFlag | UserCPredFlag | HiddenPredFlag);
1152 Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds,
1153 SyncPredFlag | HiddenPredFlag);
1154 Yap_InitCPred("$qload_program", 1, qload_program,
1155 SyncPredFlag | HiddenPredFlag);
1156 Yap_InitCPred("$q_header", 2, get_header, SyncPredFlag | HiddenPredFlag);
1157 if (FALSE) {
1158 restore_codes();
1159 }
1160}
1161
load_foreign_files/3 has works for the following configurations:
const char * Yap_AbsoluteFile(const char *spec, bool ok)
generate absolute path, if ok first expand SICStus Prolog style
Definition: absf.c:145
Definition: qly.h:41
Definition: qly.h:88
Definition: qly.h:53
Definition: qly.h:59
Definition: qly.h:76
yamop * Yap_Error__(bool throw, const char *file, const char *function, int lineno, yap_error_number type, Term where,...)
Yap_Error This function handles errors in the C code.
Definition: errors.c:981
Definition: Yatom.h:689
A matrix.
Definition: matrix.c:68
Definition: Yatom.h:295
Definition: Yatom.h:544
Definition: amidefs.h:264