mirror of
https://github.com/cookiengineer/audacity
synced 2025-10-10 16:43:33 +02:00
Move library tree where it belongs
This commit is contained in:
ra
403
lib-src/libnyquist/nyquist/xlisp/xlimage.c
Normal file
403
lib-src/libnyquist/nyquist/xlisp/xlimage.c
Normal file
@@ -0,0 +1,403 @@
|
||||
/* 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);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
Reference in New Issue
Block a user