This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/save.c
vsc a7f550d667 New comment-based message style
Fix thread support (at least don't deadlock with oneself)
small fixes for coroutining predicates
force Yap to recover space in arrays of dbrefs
use private predicates in debugger.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1084 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2004-06-23 17:24:20 +00:00

1490 lines
36 KiB
C

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: save.c *
* Last rev: *
* mods: *
* comments: saving and restoring a Prolog computation *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "@(#)save.c 1.3 3/15/90";
#endif
#if _MSC_VER || defined(__MINGW32__)
#include <windows.h>
#endif
#include "absmi.h"
#include "alloc.h"
#include "yapio.h"
#include "sshift.h"
#include "Foreign.h"
#if HAVE_STRING_H
#include <string.h>
#endif
#if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y)
#endif
#if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y)
#endif
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#include "iopreds.h"
/********* hack for accesing several kinds of terms. Should be cleaned **/
static char StartUpFile[] = "startup";
static char end_msg[256] ="*** End of YAP saved state *****";
#ifdef DEBUG
/*
*
#FOR DEBUGGING define DEBUG_RESTORE0 to check the file stuff,
#define DEBUG_RESTORE1 to see if it is able to prepare the chain,
#define DEBUG_RESTORE2 to see how things are going,
#define DEBUG_RESTORE3 to check if the atom chain is still a working chain,
* define DEBUG_RESTORE4 if you want to set the output for some
* particular file,
* define DEBUG_RESTORE5 if you want to see how the stacks are being
* cleaned up,
* define DEBUG_RESTORE6 if you want to follow the execution in
*
* Also a file is defined where you can write things, by default stderr
*
* Good Luck
*/
#endif
STATIC_PROTO(void myread, (int, char *, Int));
STATIC_PROTO(void mywrite, (int, char *, Int));
STATIC_PROTO(int open_file, (char *, int));
STATIC_PROTO(void close_file, (void));
STATIC_PROTO(void putout, (CELL));
STATIC_PROTO(void putcellptr, (CELL *));
STATIC_PROTO(CELL get_cell, (void));
STATIC_PROTO(CELL *get_cellptr, ( /* CELL * */ void));
STATIC_PROTO(void put_info, (int, int));
STATIC_PROTO(void save_regs, (int));
STATIC_PROTO(void save_code_info, (void));
STATIC_PROTO(void save_heap, (void));
STATIC_PROTO(void save_stacks, (int));
STATIC_PROTO(void save_crc, (void));
STATIC_PROTO(Int do_save, (int));
STATIC_PROTO(Int p_save, (void));
STATIC_PROTO(Int p_save_program, (void));
STATIC_PROTO(int check_header, (CELL *, CELL *, CELL *, CELL *));
STATIC_PROTO(void get_heap_info, (void));
STATIC_PROTO(void get_regs, (int));
STATIC_PROTO(void get_insts, (OPCODE []));
STATIC_PROTO(void get_hash, (void));
STATIC_PROTO(void CopyCode, (void));
STATIC_PROTO(void CopyStacks, (void));
STATIC_PROTO(void get_coded, (int, OPCODE []));
STATIC_PROTO(void restore_codes, (void));
STATIC_PROTO(Term AdjustDBTerm, (Term, Term *));
STATIC_PROTO(void RestoreDB, (DBEntry *));
STATIC_PROTO(void CleanClauses, (yamop *, yamop *,PredEntry *));
STATIC_PROTO(void rehash, (CELL *, int, int));
STATIC_PROTO(void CleanCode, (PredEntry *));
STATIC_PROTO(void RestoreEntries, (PropEntry *));
STATIC_PROTO(void RestoreInvisibleAtoms, (void));
STATIC_PROTO(void RestoreFreeSpace, (void));
STATIC_PROTO(void restore_heap, (void));
#ifdef DEBUG_RESTORE3
STATIC_PROTO(void ShowAtoms, (void));
STATIC_PROTO(void ShowEntries, (PropEntry *));
#endif
STATIC_PROTO(int OpenRestore, (char *, char *, CELL *, CELL *, CELL *, CELL *));
STATIC_PROTO(void CloseRestore, (void));
STATIC_PROTO(int check_opcodes, (OPCODE []));
STATIC_PROTO(void RestoreHeap, (OPCODE []));
STATIC_PROTO(Int p_restore, (void));
STATIC_PROTO(void restore_heap_regs, (void));
STATIC_PROTO(void restore_regs, (int));
#ifdef MACYAP
STATIC_PROTO(void NewFileInfo, (long, long));
extern int DefVol;
#endif
#if HAVE_IO_H
#include <io.h>
#endif
#ifdef LIGHT
#include <unix.h>
#include <strings.h>
void
LightBug(char *);
static void
LightBug(s)
char *s;
{
}
#endif /* LIGHT */
#if SHORT_INTS
#ifdef M_WILLIAMS
#include <fcntl.h>
#endif
static void
myread(int fd, char *buff, Int len)
{
while (len > 16000) {
int nchars = read(fd, buff, 16000);
if (nchars <= 0)
Yap_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
len -= 16000;
buff += 16000;
}
read(fd, buff, (unsigned) len);
}
static void
mywrite(int fd, char *buff, Int len)
{
while (len > 16000) {
write(fd, buff, 16000);
len -= 16000;
buff += 16000;
}
write(fd, buff, (unsigned) len);
}
#else /* SHORT_INTS */
inline static
void myread(int fd, char *buffer, Int len) {
int nread;
while (len > 0) {
nread = read(fd, buffer, (int)len);
if (nread < 1) {
Yap_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
}
buffer += nread;
len -= nread;
}
}
inline static
void mywrite(int fd, char *buff, Int len) {
Int nwritten;
while (len > 0) {
nwritten = (Int)write(fd, buff, (int)len);
if (nwritten == -1) {
Yap_Error(SYSTEM_ERROR,TermNil,"write error while saving");
}
buff += nwritten;
len -= nwritten;
}
}
#endif /* SHORT_INTS */
#define FullSaved 1
/* Where the code was before */
typedef CELL *CELLPOINTER;
static int splfild = 0;
#ifdef DEBUG
#ifdef DEBUG_RESTORE4
static FILE *errout;
#else
#define errout Yap_stderr
#endif
#endif /* DEBUG */
static Int OldHeapUsed;
static CELL which_save;
/* Open a file to read or to write */
static int
open_file(char *my_file, int flag)
{
int splfild;
#ifdef M_WILLIAMS
if (flag & O_CREAT)
splfild = creat(my_file, flag);
else
splfild = open(my_file, flag);
if (splfild < 0) {
#else
#ifdef O_BINARY
#if _MSC_VER
if ((splfild = _open(my_file, flag | O_BINARY), _S_IREAD | _S_IWRITE) < 0)
#else
if ((splfild = open(my_file, flag | O_BINARY, 0775)) < 0)
#endif
#else /* O_BINARY */
if ((splfild = open(my_file, flag, 0755)) < 0)
#endif /* O_BINARY */
#endif /* M_WILLIAMS */
{
splfild = 0; /* We do not have an open file */
return(-1);
}
#ifdef undf0
fprintf(errout, "Opened file %s\n", my_file);
#endif
return(splfild);
}
static void
close_file(void)
{
if (splfild == 0)
return;
close(splfild);
splfild = 0;
}
/* stores a cell in a file */
static void
putout(CELL l)
{
mywrite(splfild, (char *) &l, sizeof(CELL));
}
/* stores a pointer to a cell in a file */
static void
putcellptr(CELL *l)
{
mywrite(splfild, (char *) &l, sizeof(CELLPOINTER));
}
/* gets a cell from a file */
static CELL
get_cell(void)
{
CELL l;
myread(splfild, (char *) &l, Unsigned(sizeof(CELL)));
return (l);
}
/* gets a cell from a file */
static CELL
get_header_cell(void)
{
CELL l;
int count = 0, n;
while (count < sizeof(CELL)) {
if ((n = read(splfild, &l, sizeof(CELL)-count)) < 0) {
Yap_ErrorMessage = "corrupt saved state (too short)";
return(0L);
}
count += n;
}
return(l);
}
/* gets a pointer to cell from a file */
static CELL *
get_cellptr(void)
{
CELL *l;
myread(splfild, (char *) &l, Unsigned(sizeof(CELLPOINTER)));
return (l);
}
/*
* writes the header (at the moment YAPV*), info about what kind of saved
* set, the work size, and the space ocuppied
*/
static void
put_info(int info, int mode)
{
char msg[256];
sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%cYAPV%s", BIN_DIR, 1, YAP_VERSION);
mywrite(splfild, msg, strlen(msg) + 1);
putout(Unsigned(info));
/* say whether we just saved the heap or everything */
putout(mode);
/* current state of stacks, to be used by SavedInfo */
/* space available in heap area */
putout(Unsigned(Yap_GlobalBase)-Unsigned(Yap_HeapBase));
/* space available for stacks */
putout(Unsigned(Yap_LocalBase)-Unsigned(Yap_GlobalBase));
/* space available for trail */
putout(Unsigned(Yap_TrailTop)-Unsigned(Yap_TrailBase));
/* Space used in heap area */
putout(Unsigned(HeapTop)-Unsigned(Yap_HeapBase));
/* Space used for local stack */
putout(Unsigned(LCL0)-Unsigned(ASP));
/* Space used for global stack */
putout(Unsigned(H) - Unsigned(Yap_GlobalBase));
/* Space used for trail */
putout(Unsigned(TR) - Unsigned(Yap_TrailBase));
}
static void
save_regs(int mode)
{
/* save all registers */
putout((CELL)compile_arrays);
if (mode == DO_EVERYTHING) {
putcellptr((CELL *)CP);
putcellptr(ENV);
putcellptr(ASP);
/* putout((CELL)N); */
putcellptr(H0);
putcellptr(LCL0);
putcellptr(H);
putcellptr(HB);
putcellptr((CELL *)B);
putcellptr((CELL *)TR);
putcellptr(YENV);
putcellptr(S);
putcellptr((CELL *)P);
putout(CreepFlag);
putout(EX);
#ifdef COROUTINING
putout(DelayedVars);
#endif
}
putout(CurrentModule);
if (mode == DO_EVERYTHING) {
#ifdef COROUTINING
putout(WokenGoals);
#endif
#ifdef DEPTH_LIMIT
putout(DEPTH);
#endif
}
/* The operand base */
putcellptr(CellPtr(XREGS));
putout(which_save);
/* Now start by saving the code */
/* the heap boundaries */
putcellptr(CellPtr(Yap_HeapBase));
putcellptr(CellPtr(HeapTop));
/* and the space it ocuppies */
putout(Unsigned(HeapUsed));
/* Then the start of the free code */
putcellptr(CellPtr(FreeBlocks));
if (mode == DO_EVERYTHING) {
/* put the old trail base, just in case it moves again */
putout(ARG1);
if (which_save == 2) {
putout(ARG2);
}
putcellptr(CellPtr(Yap_TrailBase));
}
}
static void
save_code_info(void)
{
/* First the instructions */
{
op_numbers i;
OPCODE my_ops[_std_top+1];
for (i = _Ystop; i <= _std_top; ++i)
my_ops[i] = Yap_opcode(i);
mywrite(splfild, (char *)my_ops, sizeof(OPCODE)*(_std_top+1));
}
/* and the current character codes */
mywrite(splfild, Yap_chtype, NUMBER_OF_CHARS);
}
static void
save_heap(void)
{
int j;
/* Then save the whole heap */
#if defined(YAPOR) || defined(TABLING)
/* skip the local and global data structures */
j = Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase);
putout(j);
mywrite(splfild, (char *) Yap_HeapBase, j);
#ifdef USE_HEAP
j = Unsigned(HeapTop) - Unsigned(&HashChain);
putout(j);
mywrite(splfild, (char *) &HashChain, j);
#else
j = Unsigned(BaseAllocArea) - Unsigned(&HashChain);
putout(j);
mywrite(splfild, (char *) &HashChain, j);
j = Unsigned(HeapTop) - Unsigned(TopAllocBlockArea);
putout(j);
mywrite(splfild, (char *) TopAllocBlockArea, j);
#endif
#else
j = Unsigned(HeapTop) - Unsigned(Yap_HeapBase);
/* store 10 more cells because of the memory manager */
mywrite(splfild, (char *) Yap_HeapBase, j);
#endif /* YAPOR || TABLING */
}
static void
save_stacks(int mode)
{
int j;
switch (mode) {
case DO_EVERYTHING:
/* Now, go and save the state */
/* Save the local stack */
j = Unsigned(LCL0) - Unsigned(ASP);
mywrite(splfild, (char *) ASP, j);
/* Save the global stack */
j = Unsigned(H) - Unsigned(Yap_GlobalBase);
mywrite(splfild, (char *) Yap_GlobalBase, j);
/* Save the trail */
j = Unsigned(TR) - Unsigned(Yap_TrailBase);
mywrite(splfild, (char *) Yap_TrailBase, j);
break;
case DO_ONLY_CODE:
{
tr_fr_ptr tr_ptr = TR;
while (tr_ptr != (tr_fr_ptr)Yap_TrailBase) {
CELL val = TrailTerm(tr_ptr-1);
if (IsVarTerm(val)) {
CELL *d1 = VarOfTerm(val);
if (d1 < (CELL *)HeapTop)
putout(val);
} else if (IsPairTerm(val)) {
CELL *d1 = RepPair(val);
if (d1 < (CELL *)HeapTop)
putout(val);
}
tr_ptr--;
}
}
putcellptr(NULL);
break;
}
}
static void
save_crc(void)
{
/* Save a CRC */
mywrite(splfild, end_msg, 256);
#ifdef MACYAP
NewFileInfo('TEXT', 'MYap');
if (DefVol)
SetVol(0l, DefVol);
DefVol = 0;
#endif
}
static Int
do_save(int mode) {
#ifdef MACYAP
NewFileInfo('YAPS', 'MYap');
#endif
Term t1 = Deref(ARG1);
if (!Yap_GetName(Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
Yap_Error(TYPE_ERROR_LIST,t1,"save/1");
return(FALSE);
}
Yap_CloseStreams(TRUE);
if ((splfild = open_file(Yap_FileNameBuf, O_WRONLY | O_CREAT)) < 0) {
Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)),
"restore/1, open(%s)", strerror(errno));
return(FALSE);
}
put_info(FullSaved, mode);
save_regs(mode);
save_code_info();
save_heap();
save_stacks(mode);
save_crc();
close_file();
return (TRUE);
}
/* Saves a complete prolog environment */
static Int
p_save(void)
{
#if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#endif
which_save = 1;
return(do_save(DO_EVERYTHING));
}
/* Saves a complete prolog environment */
static Int
p_save2(void)
{
#if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,
"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#endif
which_save = 2;
return(do_save(DO_EVERYTHING) && Yap_unify(ARG2,MkIntTerm(1)));
}
/* Just save the program, not the stacks */
static Int
p_save_program(void)
{
which_save = 0;
return(do_save(DO_ONLY_CODE));
}
/* Now, to restore the saved code */
/* First check out if we are dealing with a valid file */
static int
check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
{
char pp[80];
char msg[256];
CELL hp_size, gb_size, lc_size, tr_size, mode;
/* make sure we always check if there are enough bytes */
/* skip the first line */
do {
if (read(splfild, pp, 1) < 0) {
Yap_ErrorMessage = "corrupt saved state (failed to read first line)";
return(FAIL_RESTORE);
}
} while (pp[0] != 1);
/* now check the version */
sprintf(msg, "YAPV%s", YAP_VERSION);
{
int count = 0, n, to_read = Unsigned(strlen(msg) + 1);
while (count < to_read) {
if ((n = read(splfild, pp, to_read-count)) < 0) {
Yap_ErrorMessage = "corrupt saved state (header too short)";
return(FAIL_RESTORE);
}
count += n;
}
}
if (pp[0] != 'Y' && pp[1] != 'A' && pp[0] != 'P') {
Yap_ErrorMessage = "corrupt saved state (should say YAP)";
return(FAIL_RESTORE);
}
if (strcmp(pp, msg) != 0) {
Yap_ErrorMessage = "corrupt saved state (different version of YAP)";
return(FAIL_RESTORE);
}
/* check info on header */
/* ignore info on saved state */
*info = get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
/* check the restore mode */
mode = get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) {
Yap_ErrorMessage = "corrupt saved state (bad type)";
return(FAIL_RESTORE);
}
/* ignore info on stacks size */
*AHeap = get_header_cell();
*AStack = get_header_cell();
*ATrail = get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
/* now, check whether we got enough enough space to load the
saved space */
hp_size = get_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
while (Yap_HeapBase != NULL &&
hp_size > Unsigned(HeapLim) - Unsigned(Yap_HeapBase)) {
if(!Yap_growheap(FALSE, hp_size, NULL)) {
return(FAIL_RESTORE);
}
}
if (mode == DO_EVERYTHING) {
lc_size = get_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
gb_size=get_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
if (Yap_HeapBase != NULL && lc_size+gb_size > Unsigned(Yap_LocalBase) - Unsigned(Yap_GlobalBase)) {
Yap_ErrorMessage = "not enough stack space for restore";
return(FAIL_RESTORE);
}
if (Yap_HeapBase != NULL && (tr_size = get_cell()) > Unsigned(Yap_TrailTop) - Unsigned(Yap_TrailBase)) {
Yap_ErrorMessage = "not enough trail space for restore";
return(FAIL_RESTORE);
}
} else {
/* skip cell size */
get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
get_header_cell();
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
}
return(mode);
}
/* Gets the state of the heap, and evaluates the related variables */
static void
get_heap_info(void)
{
OldHeapBase = (ADDR) get_cellptr();
OldHeapTop = (ADDR) get_cellptr();
OldHeapUsed = (Int) get_cell();
FreeBlocks = (BlockHeader *) get_cellptr();
HDiff = Unsigned(Yap_HeapBase) - Unsigned(OldHeapBase);
}
/* Gets the register array */
/* Saves the old bases for the work areas */
/* and evaluates the difference from the old areas to the new ones */
static void
get_regs(int flag)
{
CELL *NewGlobalBase = (CELL *)Yap_GlobalBase;
CELL *NewLCL0 = LCL0;
CELL *OldXREGS;
/* Get regs */
compile_arrays = (int)get_cell();
if (flag == DO_EVERYTHING) {
CP = (yamop *)get_cellptr();
ENV = get_cellptr();
ASP = get_cellptr();
/* N = get_cell(); */
H0 = get_cellptr();
LCL0 = get_cellptr();
H = get_cellptr();
HB = get_cellptr();
B = (choiceptr)get_cellptr();
TR = (tr_fr_ptr)get_cellptr();
YENV = get_cellptr();
S = get_cellptr();
P = (yamop *)get_cellptr();
CreepFlag = get_cell();
#ifdef COROUTINING
DelayedVars = get_cell();
#endif
}
CurrentModule = get_cell();
if (flag == DO_EVERYTHING) {
#ifdef COROUTINING
WokenGoals = get_cell();
#endif
#ifdef DEPTH_LIMIT
DEPTH = get_cell();
#endif
}
/* Get the old bases */
OldXREGS = get_cellptr();
which_save = get_cell();
XDiff = (CELL)XREGS - (CELL)OldXREGS;
get_heap_info();
if (flag == DO_EVERYTHING) {
ARG1 = get_cell();
if (which_save == 2) {
ARG2 = get_cell();
}
/* get old trail base */
OldTrailBase = (ADDR)get_cellptr();
/* Save the old register where we can easily access them */
OldASP = ASP;
OldLCL0 = LCL0;
OldGlobalBase = (CELL *)Yap_GlobalBase;
OldH = H;
OldTR = TR;
GDiff = Unsigned(NewGlobalBase) - Unsigned(Yap_GlobalBase);
LDiff = Unsigned(NewLCL0) - Unsigned(LCL0);
TrDiff = LDiff;
Yap_GlobalBase = (ADDR)NewGlobalBase;
LCL0 = NewLCL0;
}
}
/* Get the old opcodes and place them in a hash table */
static void
get_insts(OPCODE old_ops[])
{
myread(splfild, (char *)old_ops, sizeof(OPCODE)*(_std_top+1));
}
/* Get the old atoms hash table */
static void
get_hash(void)
{
myread(splfild, Yap_chtype , NUMBER_OF_CHARS);
}
/* Copy all of the old code to the new Heap */
static void
CopyCode(void)
{
#if defined(YAPOR) || defined(TABLING)
/* skip the local and global data structures */
CELL j = get_cell();
if (j != Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase)) {
Yap_Error(FATAL_ERROR,TermNil,"bad saved state (code space size does not match)");
}
myread(splfild, (char *) Yap_HeapBase, j);
#ifdef USE_HEAP
j = get_cell();
myread(splfild, (char *) &HashChain, j);
#else
j = get_cell();
if (j != Unsigned(BaseAllocArea) - Unsigned(&HashChain)) {
Yap_Error(FATAL_ERROR,TermNil,"bad saved state (Base to Hash does not match)");
}
myread(splfild, (char *) &HashChain, j);
j = get_cell();
myread(splfild, (char *) TopAllocBlockArea, j);
#endif
#else
myread(splfild, (char *) Yap_HeapBase,
(Unsigned(OldHeapTop) - Unsigned(OldHeapBase)));
#endif /* YAPOR || TABLING */
}
/* Copy the local and global stack and also the trail to their new home */
/* In REGS we still have nonadjusted values !! */
static void
CopyStacks(void)
{
Int j;
char *NewASP;
j = Unsigned(OldLCL0) - Unsigned(ASP);
NewASP = (char *) (Unsigned(ASP) + (Unsigned(LCL0) - Unsigned(OldLCL0)));
myread(splfild, (char *) NewASP, j);
j = Unsigned(H) - Unsigned(OldGlobalBase);
myread(splfild, (char *) Yap_GlobalBase, j);
j = Unsigned(TR) - Unsigned(OldTrailBase);
myread(splfild, Yap_TrailBase, j);
}
/* Copy the local and global stack and also the trail to their new home */
/* In REGS we still have nonadjusted values !! */
static void
CopyTrailEntries(void)
{
CELL entry, *Entries;
Entries = (CELL *)Yap_TrailBase;
do {
*Entries++ = entry = get_cell();
} while ((CODEADDR)entry != NULL);
}
/* get things which are saved in the file */
static void
get_coded(int flag, OPCODE old_ops[])
{
char my_end_msg[256];
get_regs(flag);
get_insts(old_ops);
get_hash();
CopyCode();
switch (flag) {
case DO_EVERYTHING:
CopyStacks();
break;
case DO_ONLY_CODE:
CopyTrailEntries();
break;
}
/* Check CRC */
myread(splfild, my_end_msg, 256);
if (strcmp(end_msg,my_end_msg) != 0)
Yap_Error(FATAL_ERROR,TermNil,"corrupt saved state (bad trailing CRC)");
}
/* restore some heap registers */
static void
restore_heap_regs(void)
{
HeapTop = AddrAdjust(HeapTop);
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
HeapMax = HeapUsed = OldHeapUsed;
restore_codes();
}
/* adjust abstract machine registers */
static void
restore_regs(int flag)
{
restore_heap_regs();
if (flag == DO_EVERYTHING) {
CP = PtoOpAdjust(CP);
ENV = PtoLocAdjust(ENV);
ASP = PtoLocAdjust(ASP);
H = PtoGloAdjust(H);
B = (choiceptr)PtoLocAdjust(CellPtr(B));
TR = PtoTRAdjust(TR);
P = PtoOpAdjust(P);
HB = PtoLocAdjust(HB);
YENV = PtoLocAdjust(YENV);
S = PtoGloAdjust(S);
#ifdef COROUTINING
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
#ifdef MULTI_ASSIGNMENT_VARIABLES
WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(WokenGoals)));
#endif
#endif
}
}
static void
recompute_mask(DBRef dbr)
{
if (dbr->Flags & DBNoVars) {
dbr->Mask = Yap_EvalMasks((Term) dbr->DBT.Entry, &(dbr->Key));
} else if (dbr->Flags & DBComplex) {
/* This is quite nasty, we want to recalculate the mask but
we don't want to rebuild the whole term. We'll just build whatever we
need to recompute the mask.
*/
CELL *x = (CELL *)HeapTop, *tp;
unsigned int Arity, i;
Term out;
char *tbase = CharP(dbr->DBT.Contents-1);
if (IsPairTerm(dbr->DBT.Entry)) {
out = AbsPair(x);
Arity = 2;
tp = (CELL *)(tbase + (CELL) RepPair(dbr->DBT.Entry));
} else {
Functor f;
tp = (CELL *)(tbase + (CELL) RepAppl(dbr->DBT.Entry));
f = (Functor)(*tp++);
out = AbsAppl(x);
Arity = ArityOfFunctor(f);
*x++ = (CELL)f;
if (Arity > 3) Arity = 3;
}
for (i = 0; i < Arity; i++) {
register Term tw = *tp++;
if (IsVarTerm(tw)) {
RESET_VARIABLE(x);
} else if (IsApplTerm(tw)) {
/* just fetch the functor from where it is in the data-base.
This guarantees we have access to references and friends. */
CELL offset = (CELL)RepAppl(tw);
if (offset > dbr->DBT.NOfCells*sizeof(CELL))
*x = tw;
else
*x = AbsAppl((CELL *)(tbase + offset));
} else if (IsAtomicTerm(tw)) {
*x = tw;
} else if (IsPairTerm(tw)) {
*x = AbsPair(x);
}
x++;
}
dbr->Mask = Yap_EvalMasks(out, &(dbr->Key));
}
}
#define HASH_SHIFT 6
/*
* This is used to make an hash table correct, after displacing its elements,
* HCEnd should point to an area of free space, usually in the heap. The
* routine is very dependent on the hash function used, and it destroys the
* previous "hit" order
*/
static void
rehash(CELL *oldcode, int NOfE, int KindOfEntries)
{
register CELL *savep, *basep;
CELL *oldp = oldcode;
int TableSize = NOfE - 1, NOfEntries;
register int i;
int hash;
CELL WorkTerm, failplace = 0;
CELL *Base = oldcode;
if (HDiff == 0)
return;
basep = H;
if (H + (NOfE*2) > ASP) {
basep = (CELL *)TR;
if (basep + (NOfE*2) > (CELL *)Yap_TrailTop) {
if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-Yap_TrailTop)) {
Yap_Error(SYSTEM_ERROR, TermNil,
"not enough space to restore hash tables for indexing");
Yap_exit(1);
}
}
}
for (i = 0; i < NOfE; ++i) {
if (*oldp == 0) {
failplace = oldp[1];
break;
}
oldp += 2;
}
savep = basep;
oldp = oldcode;
for (i = 0; i < NOfE; ++i) {
if (*oldp != 0) {
savep[0] = oldp[0];
savep[1] = oldp[1];
oldp[0] = 0;
oldp[1] = failplace;
savep += 2;
}
oldp += 2;
}
NOfEntries = (savep - basep)/2;
savep = basep;
for (i = 0; i < NOfEntries; ++i) {
register Int d;
CELL *hentry;
WorkTerm = savep[i*2];
hash = (Unsigned(WorkTerm) >> HASH_SHIFT) & TableSize;
hentry = Base + hash * 2;
d = TableSize & (Unsigned(WorkTerm) | 1);
while (*hentry) {
#ifdef DEBUG
#ifdef CLASHES
++clashes;
#endif /* CLASHES */
#endif /* DEBUG */
hash = (hash + d) & TableSize;
hentry = Base + hash * 2;
}
hentry[0] = WorkTerm;
hentry[1] = savep[i*2+1];
}
}
#include "rheap.h"
/* restore the atom entries which are invisible for the user */
static void
RestoreForeignCodeStructure(void)
{
ForeignObj *f_code;
if (ForeignCodeLoaded != NULL)
ForeignCodeLoaded = (void *)AddrAdjust((ADDR)ForeignCodeLoaded);
f_code = ForeignCodeLoaded;
while (f_code != NULL) {
StringList objs, libs;
if (f_code->objs != NULL)
f_code->objs = (StringList)AddrAdjust((ADDR)f_code->objs);
objs = f_code->objs;
while (objs != NULL) {
if (objs->next != NULL)
objs->next = (StringList)AddrAdjust((ADDR)objs->next);
if (objs->s != NULL)
objs->s = (char *)AddrAdjust((ADDR)objs->s);
objs = objs->next;
}
if (f_code->libs != NULL)
f_code->libs = (StringList)AddrAdjust((ADDR)f_code->libs);
libs = f_code->libs;
while (libs != NULL) {
if (libs->next != NULL)
libs->next = (StringList)AddrAdjust((ADDR)libs->next);
if (libs->s != NULL)
libs->s = (char *)AddrAdjust((ADDR)libs->s);
libs = libs->next;
}
if (f_code->f != NULL)
f_code->f = (char *)AddrAdjust((ADDR)f_code->f);
if (f_code->next != NULL)
f_code->next = (ForeignObj *)AddrAdjust((ADDR)f_code->f);
f_code = f_code->next;
}
}
/* restore the atom entries which are invisible for the user */
static void
RestoreIOStructures(void)
{
Yap_InitStdStreams();
}
/* restores the list of free space, with its curious structure */
static void
RestoreFreeSpace(void)
{
register BlockHeader *bpt, *bsz;
if (FreeBlocks != NULL)
FreeBlocks = BlockAdjust(FreeBlocks);
bpt = FreeBlocks;
while (bpt != NULL) {
if (bpt->b_next != NULL) {
bsz = bpt->b_next = BlockAdjust(bpt->b_next);
while (bsz != NULL) {
if (bsz->b_next_size != NULL)
bsz->b_next_size = BlockAdjust(bsz->b_next_size);
if (bsz->b_next != NULL)
bsz->b_next = BlockAdjust(bsz->b_next);
bsz = bsz->b_next;
}
}
if (bpt->b_next_size != NULL)
bpt->b_next_size = BlockAdjust(bpt->b_next_size);
bpt = bpt->b_next_size;
}
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
}
/* restore the atom entries which are invisible for the user */
static void
RestoreInvisibleAtoms(void)
{
AtomEntry *at;
Atom atm = INVISIBLECHAIN.Entry;
INVISIBLECHAIN.Entry = atm = AtomAdjust(atm);
at = RepAtom(atm);
if (EndOfPAEntr(at))
return;
do {
#ifdef DEBUG_RESTORE2 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif
at->PropsOfAE = PropAdjust(at->PropsOfAE);
RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE;
at->NextOfAE = atm = AtomAdjust(atm);
at = RepAtom(atm);
}
while (!EndOfPAEntr(at));
}
/*
* This is the really tough part, to restore the whole of the heap
*/
static void
restore_heap(void)
{
AtomHashEntry *HashPtr = HashChain;
register int i;
for (i = 0; i < AtomHashTableSize; ++i) {
Atom atm = HashPtr->Entry;
if (atm) {
AtomEntry *at;
HashPtr->Entry = atm = AtomAdjust(atm);
at = RepAtom(atm);
do {
#ifdef DEBUG_RESTORE2 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif
at->PropsOfAE = PropAdjust(at->PropsOfAE);
RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE = AtomAdjust(at->NextOfAE);
at = RepAtom(atm);
} while (!EndOfPAEntr(at));
}
HashPtr++;
}
RestoreInvisibleAtoms();
RestoreForeignCodeStructure();
RestoreIOStructures();
}
#ifdef DEBUG_RESTORE3
static void
ShowEntries(pp)
PropEntry *pp;
{
while (!EndOfPAEntr(pp)) {
fprintf(Yap_stderr,"Estou a ver a prop %x em %x\n", pp->KindOfPE, pp);
pp = RepProp(pp->NextOfPE);
}
}
static void
ShowAtoms()
{
AtomHashEntry *HashPtr = HashChain;
register int i;
for (i = 0; i < AtomHashTableSize; ++i) {
if (HashPtr->Entry != NIL) {
AtomEntry *at;
at = RepAtom(HashPtr->Entry);
do {
fprintf(Yap_stderr,"Passei ao %s em %x\n", at->StrOfAE, at);
ShowEntries(RepProp(at->PropsOfAE));
} while (!EndOfPAEntr(at = RepAtom(at->NextOfAE)));
}
HashPtr++;
}
}
#endif /* DEBUG_RESTORE3 */
#include <stdio.h>
static int
commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap) {
int mode;
if ((mode = check_header(Astate,ATrail,AStack,AHeap)) == FAIL_RESTORE)
return(FAIL_RESTORE);
Yap_PrologMode = BootMode;
if (Yap_HeapBase) {
if (!yap_flags[HALT_AFTER_CONSULT_FLAG]) {
Yap_TrueFileName(s,Yap_FileNameBuf2, YAP_FILENAME_MAX);
fprintf(stderr, "%% Restoring file %s\n", Yap_FileNameBuf2);
}
Yap_CloseStreams(TRUE);
}
#ifdef DEBUG_RESTORE4
/*
* This should be another file, like the log file
*/
errout = Yap_stderr;
#endif
return(mode);
}
static void
cat_file_name(char *s, char *prefix, char *name, unsigned int max_length)
{
strncpy(s, prefix, max_length);
#if _MSC_VER || defined(__MINGW32__)
strncat(s,"\\", max_length);
#else
strncat(s,"/", max_length);
#endif
strncat(s, name, max_length);
}
static int
OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap)
{
int mode = FAIL_RESTORE;
Yap_ErrorMessage = NULL;
if (inpf == NULL)
inpf = StartUpFile;
if (inpf != NULL && (splfild = open_file(inpf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(inpf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) {
Yap_ErrorMessage = NULL;
return(mode);
}
}
if (!Yap_dir_separator(inpf[0]) && !Yap_volume_header(inpf)) {
/*
we have a relative path for the file, try to do somewhat better
using YAPLIBDIR or friends.
*/
if (YapLibDir != NULL) {
cat_file_name(Yap_FileNameBuf, Yap_LibDir, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(Yap_FileNameBuf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) {
Yap_ErrorMessage = NULL;
return(mode);
}
}
}
#if HAVE_GETENV
{
char *yap_env = getenv("YAPLIBDIR");
if (yap_env != NULL) {
cat_file_name(Yap_FileNameBuf, yap_env, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(Yap_FileNameBuf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) {
Yap_ErrorMessage = NULL;
return(mode);
}
}
}
}
#endif
if (LIB_DIR != NULL) {
cat_file_name(Yap_FileNameBuf, LIB_DIR, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(Yap_FileNameBuf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) {
Yap_ErrorMessage = NULL;
return(mode);
}
}
}
}
/* could not open file */
if (Yap_ErrorMessage == NULL) {
Yap_Error(SYSTEM_ERROR,TermNil,"could not open %s,",inpf);
} else {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
}
Yap_ErrorMessage = NULL;
return(FAIL_RESTORE);
}
static void
CloseRestore(void)
{
#ifdef DEBUG_RESTORE3
ShowAtoms();
#endif
close_file();
Yap_PrologMode = UserMode;
}
static int
check_opcodes(OPCODE old_ops[])
{
#if USE_THREADED_CODE
int have_shifted = FALSE;
op_numbers op = _Ystop;
for (op = _Ystop; op < _std_top; op++) {
if (Yap_opcode(op) != old_ops[op]) {
have_shifted = TRUE;
break;
}
}
return(have_shifted);
#else
return(FALSE);
#endif
}
static void
RestoreHeap(OPCODE old_ops[])
{
int heap_moved = (OldHeapBase != Yap_HeapBase), opcodes_moved;
opcodes_moved = check_opcodes(old_ops);
/* opcodes_moved has side-effects and should be tried first */
if (heap_moved || opcodes_moved) {
restore_heap();
}
/* This must be done after restore_heap */
if (heap_moved) {
RestoreFreeSpace();
}
Yap_InitAbsmi();
if (opcodes_moved) {
Yap_InitCPreds();
Yap_InitBackCPreds();
}
if (!(Yap_ReInitConstExps() &&
Yap_ReInitUnaryExps() &&
Yap_ReInitBinaryExps())) {
Yap_Error(SYSTEM_ERROR, TermNil, "arithmetic operator not in saved state");
}
#ifdef DEBUG_RESTORE1
fprintf(errout, "phase 1 done\n");
#endif
}
/*
* This function is called to know about the parameters of the last saved
* state
*/
int
Yap_SavedInfo(char *FileName, char *YapLibDir, CELL *ATrail, CELL *AStack, CELL *AHeap)
{
CELL MyTrail, MyStack, MyHeap, MyState;
int mode;
mode = OpenRestore(FileName, YapLibDir, &MyState, &MyTrail, &MyStack, &MyHeap);
close_file();
if (mode == FAIL_RESTORE) {
Yap_ErrorMessage = NULL;
return(0);
}
if (! *AHeap)
*AHeap = MyHeap / 1024;
if (mode != DO_ONLY_CODE && *AStack)
*AStack = MyStack / 1024;
if (mode != DO_ONLY_CODE && *ATrail)
*ATrail = MyTrail / 1024;
return (MyState);
}
static void
UnmarkTrEntries(void)
{
CELL entry, *Entries;
/* initialise a choice point */
B = (choiceptr)LCL0;
B--;
B->cp_ap = NOCODE;
Entries = (CELL *)Yap_TrailBase;
while ((entry = *Entries++) != (CELL)NULL) {
if (IsVarTerm(entry)) {
RESET_VARIABLE((CELL *)entry);
} else if (IsPairTerm(entry)) {
CELL *ent = CellPtoHeapAdjust(RepPair(entry));
register CELL flags;
flags = *ent;
ResetFlag(InUseMask, flags);
*ent = flags;
if (FlagOn(ErasedMask, flags)) {
if (FlagOn(DBClMask, flags)) {
Yap_ErDBE(DBStructFlagsToDBStruct(ent));
} else {
if (flags & LogUpdMask) {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(ent));
} else {
Yap_ErCl(ClauseFlagsToDynamicClause(ent));
}
}
}
}
}
B = NULL;
}
int in_limbo = FALSE;
/*
* This function is called when wanting only to restore the heap and
* associated registers
*/
static int
Restore(char *s, char *lib_dir)
{
int restore_mode;
OPCODE old_ops[_std_top+1];
CELL MyTrail, MyStack, MyHeap, MyState;
if ((restore_mode = OpenRestore(s, lib_dir, &MyState, &MyTrail, &MyStack, &MyHeap)) == FAIL_RESTORE)
return(FALSE);
Yap_ShutdownLoadForeign();
in_limbo = TRUE;
get_coded(restore_mode, old_ops);
restore_regs(restore_mode);
in_limbo = FALSE;
/*#endif*/
RestoreHeap(old_ops);
switch(restore_mode) {
case DO_EVERYTHING:
if (OldHeapBase != Yap_HeapBase ||
OldLCL0 != LCL0 ||
OldGlobalBase != (CELL *)Yap_GlobalBase ||
OldTrailBase != Yap_TrailBase) {
Yap_AdjustStacksAndTrail();
if (which_save == 2) {
Yap_AdjustRegs(2);
} else {
Yap_AdjustRegs(1);
}
break;
#ifdef DEBUG_RESTORE2
fprintf(errout, "phase 2 done\n");
#endif
}
break;
case DO_ONLY_CODE:
UnmarkTrEntries();
Yap_InitYaamRegs();
break;
}
Yap_ReOpenLoadForeign();
Yap_InitPlIO();
/* reset time */
Yap_ReInitWallTime();
CloseRestore();
if (which_save == 2) {
Yap_unify(ARG2, MkIntTerm(0));
}
return(restore_mode);
}
int
Yap_Restore(char *s, char *lib_dir)
{
return Restore(s, lib_dir);
}
static Int
p_restore(void)
{
int mode;
Term t1 = Deref(ARG1);
#if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) {
Yap_Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running");
return(FALSE);
}
#endif
if (!Yap_GetName(Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
Yap_Error(TYPE_ERROR_LIST,t1,"restore/1");
return(FALSE);
}
if ((mode = Restore(Yap_FileNameBuf, NULL)) == DO_ONLY_CODE) {
#if PUSH_REGS
restore_absmi_regs(&Yap_standard_regs);
#endif
/* back to the top level we go */
siglongjmp(Yap_RestartEnv,3);
}
return(mode != FAIL_RESTORE);
}
void
Yap_InitSavePreds(void)
{
Yap_InitCPred("$save", 1, p_save, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$save", 2, p_save2, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$save_program", 1, p_save_program, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$restore", 1, p_restore, SyncPredFlag);
}