summaryrefslogtreecommitdiff
path: root/xlisp/xlimage.c
diff options
context:
space:
mode:
Diffstat (limited to 'xlisp/xlimage.c')
-rw-r--r--xlisp/xlimage.c407
1 files changed, 407 insertions, 0 deletions
diff --git a/xlisp/xlimage.c b/xlisp/xlimage.c
new file mode 100644
index 0000000..f26075a
--- /dev/null
+++ b/xlisp/xlimage.c
@@ -0,0 +1,407 @@
+/* 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 "stdlib.h"
+#include "string.h"
+#include "xlisp.h"
+
+#ifdef SAVERESTORE
+
+/* external variables */
+extern LVAL obarray,s_gchook,s_gcflag;
+extern long nnodes,nfree,total;
+extern int anodes,nsegs,gccalls;
+extern struct segment *segs,*lastseg,*fixseg,*charseg;
+extern XLCONTEXT *xlcontext;
+extern LVAL fnodes;
+extern struct xtype_desc_struct desc_table[NTYPES];
+
+/* local variables */
+static OFFTYPE off,foff;
+static FILE *fp;
+
+/* forward declarations */
+LOCAL OFFTYPE readptr(void);
+LOCAL OFFTYPE cvoptr(LVAL p);
+LOCAL LVAL cviptr(OFFTYPE o);
+LOCAL void writeptr(OFFTYPE off);
+LOCAL void setoffset(void);
+LOCAL void writenode(LVAL node);
+LOCAL void freeimage(void);
+LOCAL void readnode(int type, LVAL node);
+
+
+/* xlisave - save the memory image */
+int xlisave(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();
+
+ /* invalidate extern type descriptor symbol caches */
+ inval_caches();
+
+ /* 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_NODE:
+ 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_NODE,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);
+}
+
+/* xlirestore - restore a saved memory image */
+int xlirestore(char *fname)
+{
+ extern FUNDEF funtab[];
+ char fullname[STRMAX+1];
+ unsigned char *cp;
+ 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;
+ 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 = osbgetc(fp)) >= 0)
+ switch (type) {
+ case FREE_NODE:
+ 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:
+ setfile(p,NULL);
+ 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;
+ }
+ }
+
+ /* 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(void)
+{
+ 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:
+ if (p->n_vsize)
+ free(p->n_vdata);
+ break;
+ case STRING:
+ if (getslength(p))
+ free((void *) getstring(p));
+ break;
+ case STREAM:
+ if ((fp = getfile(p)) && (fp != stdin && fp != stdout && fp != STDERR))
+ osclose(getfile(p));
+ break;
+ }
+ next = seg->sg_next;
+ free((void *) seg);
+ }
+}
+
+/* setoffset - output a positioning command if nodes have been skipped */
+LOCAL void setoffset(void)
+{
+ if (off != foff) {
+ osbputc(FREE_NODE,fp);
+ writeptr(off);
+ foff = off;
+ }
+}
+
+/* writenode - write a node to a file */
+LOCAL void writenode(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 void writeptr(OFFTYPE off)
+{
+ char *p = (char *)&off;
+ int n = sizeof(OFFTYPE);
+ while (--n >= 0)
+ osbputc(*p++,fp);
+}
+
+/* readnode - read a node */
+LOCAL void readnode(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);
+}
+
+/* readptr - read a pointer */
+LOCAL OFFTYPE readptr(void)
+{
+ OFFTYPE off;
+ char *p = (char *)&off;
+ int n = sizeof(OFFTYPE);
+ while (--n >= 0)
+ *p++ = osbgetc(fp);
+ return (off);
+}
+
+/* cviptr - convert a pointer on input */
+LOCAL LVAL cviptr(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 << 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");
+
+ /* 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(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);
+ /* this point will never be reached because xlerror() does a
+ longjmp(). The return is added to avoid false positive
+ error messages from static analyzers and compilers */
+ return ((OFFTYPE)NIL);
+}
+
+#endif
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-26 11:10:50 +0000