/* xlimage - xlisp memory image save/restore functions */
/*	Copyright (c) 1985, by David Michael Betz
		All Rights Reserved
		Permission is granted for unrestricted non-commercial use	*/
/* modified so that offset is in sizeof(node) units */
#include "xlisp.h"
#include <string.h>
#include <stdlib.h>

#ifdef SAVERESTORE

/* external variables */
extern LVAL obarray,xlenv,xlfenv,xldenv,s_gchook,s_gcflag;
extern long nnodes,nfree,total;
extern int anodes,nsegs,gccalls;
extern struct segment *segs,*lastseg,*fixseg,*charseg;
extern CONTEXT *xlcontext;
extern LVAL fnodes;

/* local variables */
static OFFTYPE off,foff;
static FILE *fp;

/* forward declarations */
#ifdef ANSI
OFFTYPE readptr(void);
OFFTYPE cvoptr(LVAL p);
LVAL cviptr(OFFTYPE o);
void freeimage(void);
void setoffset(void);
void writenode(LVAL node);
void writeptr(OFFTYPE off);
void readnode(int type, LVAL node);
#else
OFFTYPE readptr();
OFFTYPE cvoptr();
LVAL cviptr();
VOID freeimage();
VOID setoffset();
VOID writenode();
VOID writeptr();
VOID readnode();
#endif

/* xlisave - save the memory image */
int xlisave(fname)
  char *fname;
{
	char fullname[STRMAX+1];
	SEGMENT *seg;
	int n,i,max;
	LVAL p;

	/* default the extension */
	if (needsextension(fname)) {
		strcpy(fullname,fname);
		strcat(fullname,".wks");
		fname = fullname;
	}

	/* open the output file */
	if ((fp = osbopen(fname,"w")) == NULL)
		return (FALSE);

	/* first call the garbage collector to clean up memory */
	gc();

	/* write out the pointer to the *obarray* symbol */
	writeptr(cvoptr(obarray));

	/* setup the initial file offsets */
	off = foff = (OFFTYPE)2;

	/* write out all nodes that are still in use */
	for (seg = segs; seg != NULL; seg = seg->sg_next) {
		p = &seg->sg_nodes[0];
		for (n = seg->sg_size; --n >= 0; ++p, off++)
			switch (ntype(p)) {
			case FREE:
				break;
			case CONS:
			case USTREAM:
				setoffset();
				fputc(p->n_type,fp);
				writeptr(cvoptr(car(p)));
				writeptr(cvoptr(cdr(p)));
				foff++;
				break;
			default:
				setoffset();
				writenode(p);
				break;
		}
	}

	/* write the terminator */
	fputc(FREE,fp);
	writeptr((OFFTYPE)0);

	/* write out data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
	for (seg = segs; seg != NULL; seg = seg->sg_next) {
		p = &seg->sg_nodes[0];
		for (n = seg->sg_size; --n >= 0; ++p)
			switch (ntype(p)) {
			case SYMBOL:
			case OBJECT:
			case VECTOR:
			case CLOSURE:
#ifdef STRUCTS
			case STRUCT:
#endif
				max = getsize(p);
				for (i = 0; i < max; ++i)
					writeptr(cvoptr(getelement(p,i)));
				break;
			case STRING:
				max = getslength(p);
				fwrite(getstring(p),1,max,fp);
				break;
		}
	}

	/* close the output file */
	osclose(fp);

	/* return successfully */
	return (TRUE);
}

/* xlirestore - restore a saved memory image */
int xlirestore(fname)
  char *fname;
{
	extern FUNDEF funtab[];
	char fullname[STRMAX+1];
	int n,i,max,type;
	SEGMENT *seg;
	LVAL p;

	/* default the extension */
	if (needsextension(fname)) {
		strcpy(fullname,fname);
		strcat(fullname,".wks");
		fname = fullname;
	}

	/* open the file */
	if ((fp = osbopen(fname,"r")) == NULL)
		return (FALSE);

	/* free the old memory image */
	freeimage();

	/* initialize */
	off = (OFFTYPE)2;
	total = nnodes = nfree = 0L;
	fnodes = NIL;
	segs = lastseg = NULL;
	nsegs = gccalls = 0;
	xlenv = xlfenv = xldenv = s_gchook = s_gcflag = NIL;
	xlstack = xlstkbase + EDEPTH;
	xlfp = xlsp = xlargstkbase;
	*xlsp++ = NIL;
	xlcontext = NULL;

	/* create the fixnum segment */
	if ((fixseg = newsegment(SFIXSIZE)) == NULL)
		xlfatal("insufficient memory - fixnum segment");

	/* create the character segment */
	if ((charseg = newsegment(CHARSIZE)) == NULL)
		xlfatal("insufficient memory - character segment");

	/* read the pointer to the *obarray* symbol */
	obarray = cviptr(readptr());

	/* read each node */
	while ((type = fgetc(fp)) >= 0)
		switch (type) {
		case FREE:
			if ((off = readptr()) == (OFFTYPE)0)
				goto done;
			break;
		case CONS:
		case USTREAM:
			p = cviptr(off);
			p->n_type = type;
#ifndef JGC
			p->n_flags = 0;
#endif
			rplaca(p,cviptr(readptr()));
			rplacd(p,cviptr(readptr()));
			off++;
			break;
		default:
			readnode(type,cviptr(off));
			off++;
			break;
		}
done:

	/* read the data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
	for (seg = segs; seg != NULL; seg = seg->sg_next) {
	p = &seg->sg_nodes[0];
	for (n = seg->sg_size; --n >= 0; ++p)
		switch (ntype(p)) {
		case SYMBOL:
		case OBJECT:
		case VECTOR:
		case CLOSURE:
#ifdef STRUCTS
		case STRUCT:
#endif
			max = getsize(p);
			if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
				xlfatal("insufficient memory - vector");
			total += (long)(max * sizeof(LVAL));
			for (i = 0; i < max; ++i)
				setelement(p,i,cviptr(readptr()));
			break;
		case STRING:
			max = getslength(p);
			if ((p->n_string = malloc(max)) == NULL)
				xlfatal("insufficient memory - string");
			total += (long)max;
			fread(getstring(p),1,max,fp);
			break;
		case STREAM:
			setfile(p,NULL);
			break;
		case SUBR:
		case FSUBR:
			p->n_subr = funtab[getoffset(p)].fd_subr;
			break;
		}
	}

	/* close the input file */
	osclose(fp);

	/* collect to initialize the free space */
	gc();

	/* lookup all of the symbols the interpreter uses */
	xlsymbols();

	/* return successfully */
	return (TRUE);
}

/* freeimage - free the current memory image */
LOCAL VOID freeimage()
{
	SEGMENT *seg,*next;
	FILE *fp;
	LVAL p;
	int n;

	/* free the data portion of SYMBOL/VECTOR/OBJECT/STRING nodes */
	for (seg = segs; seg != NULL; seg = next) {
	p = &seg->sg_nodes[0];
	for (n = seg->sg_size; --n >= 0; ++p)
		switch (ntype(p)) {
		case SYMBOL:
		case OBJECT:
		case VECTOR:
		case CLOSURE:
#ifdef STRUCTS
		case STRUCT:
#endif
			if (p->n_vsize)
				free(p->n_vdata);
			break;
		case STRING:
			if (getslength(p))
				free(getstring(p));
			break;
		case STREAM:
			if (((fp = getfile(p)) != 0) && 
				(fp != stdin && fp != stdout && fp != stderr))	 /* TAA BUG FIX */
			osclose(fp);
			break;
		}
	next = seg->sg_next;
	free(seg);
	}
}

/* setoffset - output a positioning command if nodes have been skipped */
LOCAL VOID setoffset()
{
	if (off != foff) {
		fputc(FREE,fp);
		writeptr(off);
		foff = off;
	}
}

/* writenode - write a node to a file */
LOCAL VOID writenode(node)
  LVAL node;
{
	fputc(node->n_type,fp);
	fwrite(&node->n_info, sizeof(union ninfo), 1, fp);
	foff++;
}

/* writeptr - write a pointer to a file */
LOCAL VOID writeptr(off)
  OFFTYPE off;
{
	fwrite(&off, sizeof(OFFTYPE), 1, fp);
}

/* readnode - read a node */
LOCAL VOID readnode(type,node)
  int type; LVAL node;
{
	node->n_type = type;
#ifndef JGC
	node->n_flags = 0;
#endif
	fread(&node->n_info, sizeof(union ninfo), 1, fp);
}

/* readptr - read a pointer */
LOCAL OFFTYPE readptr()
{
	OFFTYPE off;
	fread(&off, sizeof(OFFTYPE), 1, fp);
	return (off);
}

/* cviptr - convert a pointer on input */
LOCAL LVAL cviptr(o)
  OFFTYPE o;
{
	OFFTYPE off = (OFFTYPE)2;
	SEGMENT *seg;

	/* check for nil */
	if (o == (OFFTYPE)0)
		return ((LVAL)o);

	/* compute a pointer for this offset */
	for (seg = segs; seg != NULL; seg = seg->sg_next) {
		if (o >= off && o < off + (OFFTYPE)seg->sg_size)
			return (seg->sg_nodes + o - off);
		off += (OFFTYPE)seg->sg_size;
	}

	/* create new segments if necessary */
	for (;;) {

	/* create the next segment */
		if ((seg = newsegment(anodes)) == NULL)
			xlfatal("insufficient memory - segment");

	/* check to see if the offset is in this segment */
		if (o >= off && o < off + (OFFTYPE)seg->sg_size)
			return (seg->sg_nodes + o - off);
		off += (OFFTYPE)seg->sg_size;
	}
}
#ifdef __ZTC__
/* Special version for Zortech C */
/* cvoptr - convert a pointer on output */
LOCAL OFFTYPE cvoptr(p)
  LVAL p;
{
	OFFTYPE off = (OFFTYPE)2;
	SEGMENT *seg;
	OFFTYPE np = CVPTR(p);
	LVAL min1,max1;
	OFFTYPE min,max;

	/* check for nil and small fixnums */
	if (p == NIL)
		return ((OFFTYPE)p);

	/* compute an offset for this pointer */
	for (seg = segs; seg != NULL; seg = seg->sg_next) {
		min1 = &seg->sg_nodes[0];
		max1 = &seg->sg_nodes[seg->sg_size];
		min = CVPTR(min1);
		max = CVPTR(max1);
		if (np >= min  && np < max)
			return (off+ ((np-min)/sizeof(struct node)));
		off += (OFFTYPE)seg->sg_size;
	}

	/* pointer not within any segment */
	xlerror("bad pointer found during image save",p);
	return (0);	/* fake out compiler warning */
}
#else
/* cvoptr - convert a pointer on output */
LOCAL OFFTYPE cvoptr(p)
  LVAL p;
{
	OFFTYPE off = (OFFTYPE)2;
	SEGMENT *seg;
	OFFTYPE np = CVPTR(p);

	/* check for nil and small fixnums */
	if (p == NIL)
		return ((OFFTYPE)p);

	/* compute an offset for this pointer */
	for (seg = segs; seg != NULL; seg = seg->sg_next) {
		if (np >= CVPTR(&seg->sg_nodes[0]) &&
			np <  CVPTR(&seg->sg_nodes[seg->sg_size]))
				return (off+ ((np-CVPTR(seg->sg_nodes))/sizeof(struct node)));
			off += (OFFTYPE)seg->sg_size;
	}

	/* pointer not within any segment */
	xlerror("bad pointer found during image save",p);
	return (0);	/* fake out compiler warning */
}
#endif
#endif