This is xlimage.c in view mode; [Download] [Up]
/* 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 */
#include "xlisp.h"
#include "debug.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;
extern struct xtype_desc_struct desc_table[NTYPES];
/* local variables */
static OFFTYPE off,foff;
static FILE *fp;
/* external procedures */
extern SEGMENT *newsegment();
extern FILE *osbopen();
extern char *malloc();
/* forward declarations */
OFFTYPE readptr();
OFFTYPE cvoptr();
LVAL cviptr();
/* xlisave - save the memory image */
int xlisave(fname)
char *fname;
{
char fullname[STRMAX+1];
unsigned char *cp;
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 += 2)
switch (ntype(p)) {
case FREE:
break;
case CONS:
case USTREAM:
setoffset();
osbputc(p->n_type,fp);
writeptr(cvoptr(car(p)));
writeptr(cvoptr(cdr(p)));
foff += 2;
break;
case EXTERN:
setoffset();
osbputc(EXTERN, fp);
/* printf("saving EXTERN p = %x, desc %x\n", p, getdesc(p)); fflush(stdout);*/
writeptr((OFFTYPE) (getdesc(p) - desc_table)); /* write type index */
writeptr((OFFTYPE) 0); /* pointer gets reconstructed on input */
foff += 2;
break;
default:
setoffset();
writenode(p);
break;
}
}
/* write the terminator */
osbputc(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:
max = getsize(p);
for (i = 0; i < max; ++i)
writeptr(cvoptr(getelement(p,i)));
break;
case STRING:
max = getslength(p);
for (cp = getstring(p); --max >= 0; )
osbputc(*cp++,fp);
break;
case EXTERN:
/* printf("saving extern data for p = %x\n", p);*/
(getdesc(p)->save_meth)(fp, getinst(p));
break;
}
}
/* close the output file */
osclose(fp);
/* return successfully */
return (TRUE);
}
int dbgflg = FALSE;
int flag1;
/* xlirestore - restore a saved memory image */
int xlirestore(fname)
char *fname;
{
extern FUNDEF funtab[];
char fullname[STRMAX+1];
unsigned char *cp;
int n,i,max,type;
SEGMENT *seg;
LVAL p;
/* printf("stdin %x, stdout %x, stderr %x\n", stdin, stdout, stderr);*/
/* if (flag1 = (lastseg == dbgsg))
* { LVAL p = dbgnode;
* printf("starting restore %x: type is %d, file is %x\n", p, ntype(p),
* getfile(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);
dbgflg = TRUE;
/* free the old memory image */
/* { LVAL p = dbgnode;
* printf("before freeimage, %x: type is %d, file is %x\n", p, ntype(p),
* getfile(p));
* }
*/
freeimage();
/* printf("freeimage returns\n");*/
/* { LVAL p = dbgnode;
* printf("now, %x: type is %d, file is %x\n", p, ntype(p),
* getfile(p));
* }
*/
/* 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;
xlcontext = NULL;
/* create the fixnum segment */
if ((fixseg = newsegment(SFIXSIZE)) == NULL)
xlfatal("insufficient memory - fixnum segment");
/* printf("newsegment returns\n");*/
/* create the character segment */
if ((charseg = newsegment(CHARSIZE)) == NULL)
xlfatal("insufficient memory - character segment");
/* printf("newsegment returns\n");*/
/* printf("call readptr(1) or read a char(2) or getc(3) or peek(4) or reopen(5)?");
*{
* int c;
* while (TRUE) {
* c = ostgetc();
* if (c == '2') {
* printf("got %d from FILE %x\n", osbgetc(fp), fp);
* break;
* } else if (c == '1') break;
* else if (c == '3') {
* printf("got %d from FILE %x\n", getc(fp), fp);
* break;
* } else if (c == '4') {
* printf("fp is %x\n", fp); fflush(stdout);
* c = getc(fp);
* printf("first char of FILE %x is %d\n", fp, c);
* ungetc(c, fp);
* c = 0;
* } else if (c == '5') {
* fp = osbopen(fname, "r");
* printf("FILE is now %x\n", fp);
* } else if (c == '0') exit(0);
* }
*}
* printf("reading obarray ptr\n");
*/
/* read the pointer to the *obarray* symbol */
obarray = cviptr(readptr());
/* printf("done\n");*/
dbgflg = FALSE;
/* read each node */
while ((type = osbgetc(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;
p->n_flags = 0;
rplaca(p,cviptr(readptr()));
rplacd(p,cviptr(readptr()));
off += 2;
break;
case EXTERN:
p = cviptr(off);
/* printf("reading extern node p = %x\n", p);*/
p->n_type = EXTERN;
setdesc(p, desc_table + (int) readptr());
/* printf("type desc is %x\n", getdesc(p));*/
setinst(p, (unsigned char *) readptr());
/* printf("initial inst is %x\n", getinst(p));*/
off += 2;
break;
default:
readnode(type,cviptr(off));
off += 2;
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:
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 = (unsigned char *)malloc(max)) == NULL)
xlfatal("insufficient memory - string");
total += (long)max;
for (cp = getstring(p); --max >= 0; )
*cp++ = osbgetc(fp);
break;
case STREAM:
/* printf("nulling FILE %x in node %x\n", getfile(p), p);*/
setfile(p,NULL);
/* printf("now getfile(%x) is %x\n", p, getfile(p));*/
break;
case SUBR:
case FSUBR:
p->n_subr = funtab[getoffset(p)].fd_subr;
break;
case EXTERN:
/* printf("restoring extern %x\n", p); fflush(stdout); */
setinst(p, (getdesc(p)->restore_meth)(fp));
break;
}
if (p == dbgnode) {
/* printf("got node %x: type is %d, file is %x\n", p, ntype(p),
getfile(p));*/
}
}
}
/* close the input file */
osclose(fp);
/* printf("closed input file\n"); fflush(stdout); */
/* printf("type something:");
printf("got %d\n", ostgetc());
fp = osbopen(fname, "r");
printf("reopened %s, first byte is %d\n", fname, osbgetc(fp)); fflush(stdout);
printf("fp is %x\n", fp); fflush(stdout);
osclose(fp);
printf("closed input file again\n"); fflush(stdout);
printf("type something:");
printf("got %d\n", ostgetc());
fp = osbopen(fname, "r");
printf("reopened %s, first byte is %d\n", fname, osbgetc(fp)); fflush(stdout);
printf("fp is %x\n", fp); fflush(stdout);
osclose(fp);
printf("closed input file again\n"); fflush(stdout);
printf("type something:");
printf("got %d\n", ostgetc());
fp = osbopen(fname, "r");
printf("reopened %s, first byte is %d\n", fname, osbgetc(fp)); fflush(stdout);
printf("fp is %x\n", fp); fflush(stdout);
osclose(fp);
printf("closed input file again\n"); fflush(stdout);
*/
/* if (flag1)
* { LVAL p = dbgnode;
* printf("before gc: type of %x is %d, file is %x\n", p, ntype(p),
* getfile(p));
* }
*/
/* collect to initialize the free space */
gc();
/* if (flag1)
* { LVAL p = dbgnode;
* printf("before ival_Caches: type of %x is %d, file is %x\n", p, ntype(p),
* getfile(p));
* }
*/
/* invalidate extern type descriptor symbol caches */
inval_caches();
/* if (flag1)
* { LVAL p = dbgnode;
* printf("before xlsymbols: type of %x is %d, file is %x\n", p, ntype(p),
* getfile(p));
* }
*/
/* lookup all of the symbols the interpreter uses */
xlsymbols();
/* if (flag1)
* { LVAL p = dbgnode;
* printf("after restore: type of %x is %d, file is %x\n", p, ntype(p),
* getfile(p));
* }
*/
/* return successfully */
return (TRUE);
}
/* freeimage - free the current memory image */
LOCAL freeimage()
{
SEGMENT *seg,*next;
FILE *fp;
LVAL p;
int n;
/* printf("starting freeimage\n");*/
/* free the data portion of SYMBOL/VECTOR/OBJECT/STRING nodes */
for (seg = segs; seg != NULL; seg = next) {
/* printf("FREEING SEG %x:%x, ", seg, &seg->sg_nodes[seg->sg_size]);*/
p = &seg->sg_nodes[0];
for (n = seg->sg_size; --n >= 0; ++p)
switch (ntype(p)) {
case SYMBOL:
case OBJECT:
case VECTOR:
case CLOSURE:
if (p->n_vsize)
free(p->n_vdata);
break;
case STRING:
if (getslength(p))
free(getstring(p));
break;
case STREAM:
if ((fp = getfile(p)) &&
(fp != stdin && fp != stdout && fp != stderr)) {
/* printf("closing file of node %x in freeimage\n", p);*/
osclose(getfile(p));
}
break;
}
next = seg->sg_next;
free(seg);
}
}
/* setoffset - output a positioning command if nodes have been skipped */
LOCAL setoffset()
{
if (off != foff) {
osbputc(FREE,fp);
writeptr(off);
foff = off;
}
}
/* writenode - write a node to a file */
LOCAL writenode(node)
LVAL node;
{
char *p = (char *)&node->n_info;
int n = sizeof(union ninfo);
osbputc(node->n_type,fp);
while (--n >= 0)
osbputc(*p++,fp);
foff += 2;
}
/* writeptr - write a pointer to a file */
LOCAL writeptr(off)
OFFTYPE off;
{
char *p = (char *)&off;
int n = sizeof(OFFTYPE);
while (--n >= 0)
osbputc(*p++,fp);
}
/* readnode - read a node */
LOCAL readnode(type,node)
int type; LVAL node;
{
char *p = (char *)&node->n_info;
int n = sizeof(union ninfo);
node->n_type = type;
node->n_flags = 0;
while (--n >= 0)
*p++ = osbgetc(fp);
if (ntype(node) == STREAM) {
/* printf("readnode: FILE of node %x is %x\n", node, getfile(node));*/
}
}
/* readptr - read a pointer */
LOCAL OFFTYPE readptr()
{
OFFTYPE off;
char *p = (char *)&off;
int n = sizeof(OFFTYPE);
/* int v; */
while (--n >= 0) {
*p++ = /* v = */osbgetc(fp);
/* if (dbgflg) printf("in readptr, got %d\n", v);*/
}
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);
/* if (dbgflg) printf("cviptr(%x) ", 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 << 1))
return (seg->sg_nodes + ((int)(o - off) >> 1));
off += (OFFTYPE)(seg->sg_size << 1);
}
/* create new segments if necessary */
for (;;) {
/* create the next segment */
if ((seg = newsegment(anodes)) == NULL)
xlfatal("insufficient memory - segment");
/* printf("CREATED SEG %x:%x, ", seg, &seg->sg_nodes[seg->sg_size]);*/
/* check to see if the offset is in this segment */
if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
return (seg->sg_nodes + ((int)(o - off) >> 1));
off += (OFFTYPE)(seg->sg_size << 1);
}
}
/* cvoptr - convert a pointer on output */
LOCAL OFFTYPE cvoptr(p)
LVAL p;
{
OFFTYPE off = (OFFTYPE)2;
SEGMENT *seg;
/* 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 (CVPTR(p) >= CVPTR(&seg->sg_nodes[0]) &&
CVPTR(p) < CVPTR(&seg->sg_nodes[0] + seg->sg_size))
return (off + (OFFTYPE)((p - seg->sg_nodes) << 1));
off += (OFFTYPE)(seg->sg_size << 1);
}
/* pointer not within any segment */
xlerror("bad pointer found during image save",p);
}
#endif
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.