home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / a138_1 / c / xsimage < prev    next >
Text File  |  1991-11-26  |  9KB  |  406 lines
  1. /* xsimage.c - xscheme memory image save/restore functions */
  2. /*    Copyright (c) 1988, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xscheme.h"
  7.  
  8. /* virtual machine registers */
  9. extern LVAL xlfun;        /* current function */
  10. extern LVAL xlenv;        /* current environment */
  11. extern LVAL xlval;        /* value of most recent instruction */
  12.  
  13. /* stack limits */
  14. extern LVAL *xlstkbase;        /* base of value stack */
  15. extern LVAL *xlstktop;        /* top of value stack */
  16.  
  17. /* node space */
  18. extern NSEGMENT *nsegments;    /* list of node segments */
  19.  
  20. /* vector (and string) space */
  21. extern VSEGMENT *vsegments;    /* list of vector segments */
  22. extern LVAL *vfree;        /* next free location in vector space */
  23. extern LVAL *vtop;        /* top of vector space */
  24.  
  25. /* global variables */
  26. extern LVAL obarray,eof_object,default_object;
  27. extern jmp_buf top_level;
  28. extern FUNDEF funtab[];
  29.  
  30. /* local variables */
  31. static OFFTYPE off,foff;
  32. static FILE *fp;
  33.  
  34. /* external routines */
  35. extern FILE *osbopen();
  36.  
  37. /* forward declarations */
  38. #ifdef __STDC__
  39. static VOID freeimage(VOID);
  40. static VOID setoffset(VOID);
  41. static VOID writenode(LVAL node);
  42. static VOID writeptr(OFFTYPE off);
  43. static VOID readnode(int type,LVAL node);
  44. static OFFTYPE readptr(VOID);
  45. static LVAL cviptr(OFFTYPE o);
  46. static OFFTYPE cvoptr(LVAL p);
  47. static LVAL *getvspace(LVAL node,unsigned int size);
  48. #else
  49. static OFFTYPE readptr();
  50. static OFFTYPE cvoptr();
  51. static LVAL cviptr();
  52. static LVAL *getvspace();
  53. #endif
  54.  
  55. /* xlisave - save the memory image */
  56. int xlisave(fname)
  57.   char *fname;
  58. {
  59.     unsigned char *cp;
  60.     NSEGMENT *nseg;
  61.     int size,n;
  62.     LVAL p,*vp;
  63.  
  64.     /* open the output file */
  65.     if ((fp = osbopen(fname,"w")) == NULL)
  66.     return (FALSE);
  67.  
  68.     /* first call the garbage collector to clean up memory */
  69.     gc();
  70.  
  71.     /* write out the stack size */
  72.     writeptr((OFFTYPE)(xlstktop-xlstkbase));
  73.  
  74.     /* write out the *obarray* symbol and various constants */
  75.     writeptr(cvoptr(obarray));
  76.     writeptr(cvoptr(eof_object));
  77.     writeptr(cvoptr(default_object));
  78.  
  79.     /* setup the initial file offsets */
  80.     off = foff = (OFFTYPE)2;
  81.  
  82.     /* write out all nodes that are still in use */
  83.     for (nseg = nsegments; nseg != NULL; nseg = nseg->ns_next) {
  84.     p = &nseg->ns_data[0];
  85.     n = nseg->ns_size;
  86.     for (; --n >= 0; ++p, off += sizeof(NODE))
  87.         switch (ntype(p)) {
  88.         case FREE:
  89.         break;
  90.         case CONS:
  91.         case CLOSURE:
  92.         case METHOD:
  93.         case PROMISE:
  94.         case ENV:
  95.         setoffset();
  96.         osbputc(p->n_type,fp);
  97.         writeptr(cvoptr(car(p)));
  98.         writeptr(cvoptr(cdr(p)));
  99.         foff += sizeof(NODE);
  100.         break;
  101.         case SYMBOL:
  102.         case OBJECT:
  103.         case VECTOR:
  104.         case CODE:
  105.         case CONTINUATION:
  106.         setoffset();
  107.         osbputc(p->n_type,fp);
  108.         size = getsize(p);
  109.         writeptr((OFFTYPE)size);
  110.         for (vp = p->n_vdata; --size >= 0; )
  111.             writeptr(cvoptr(*vp++));
  112.         foff += sizeof(NODE);
  113.         break;
  114.         case STRING:
  115.         setoffset();
  116.         osbputc(p->n_type,fp);
  117.         size = getslength(p);
  118.         writeptr((OFFTYPE)size);
  119.         for (cp = (unsigned char *)getstring(p); --size >= 0; )
  120.             osbputc(*cp++,fp);
  121.         foff += sizeof(NODE);
  122.         break;
  123.         default:
  124.         setoffset();
  125.         writenode(p);
  126.         foff += sizeof(NODE);
  127.         break;
  128.         }
  129.     }
  130.  
  131.     /* write the terminator */
  132.     osbputc(FREE,fp);
  133.     writeptr((OFFTYPE)0);
  134.  
  135.     /* close the output file */
  136.     osclose(fp);
  137.  
  138.     /* return successfully */
  139.     return (TRUE);
  140. }
  141.  
  142. /* xlirestore - restore a saved memory image */
  143. int xlirestore(fname)
  144.   char *fname;
  145. {
  146.     unsigned int ssize;
  147.     unsigned char *cp;
  148.     int size,type;
  149.     LVAL p,*vp;
  150.  
  151.     /* open the file */
  152.     if ((fp = osbopen(fname,"r")) == NULL)
  153.     return (FALSE);
  154.  
  155.     /* free the old memory image */
  156.     freeimage();
  157.  
  158.     /* read the stack size */
  159.     ssize = (unsigned int)readptr();
  160.  
  161.     /* allocate memory for the workspace */
  162.     xlminit(ssize);
  163.  
  164.     /* read the *obarray* symbol and various constants */
  165.     obarray = cviptr(readptr());
  166.     eof_object = cviptr(readptr());
  167.     default_object = cviptr(readptr());
  168.     
  169.     /* read each node */
  170.     for (off = (OFFTYPE)2; (type = osbgetc(fp)) >= 0; )
  171.     switch (type) {
  172.     case FREE:
  173.         if ((off = readptr()) == (OFFTYPE)0)
  174.         goto done;
  175.         break;
  176.     case CONS:
  177.     case CLOSURE:
  178.     case METHOD:
  179.     case PROMISE:
  180.     case ENV:
  181.         p = cviptr(off);
  182.         p->n_type = type;
  183.         rplaca(p,cviptr(readptr()));
  184.         rplacd(p,cviptr(readptr()));
  185.         off += sizeof(NODE);
  186.         break;
  187.     case SYMBOL:
  188.     case OBJECT:
  189.     case VECTOR:
  190.     case CODE:
  191.     case CONTINUATION:
  192.         p = cviptr(off);
  193.         p->n_type = type;
  194.         p->n_vsize = size = (int)readptr();
  195.         p->n_vdata = getvspace(p,size);
  196.         for (vp = p->n_vdata; --size >= 0; )
  197.         *vp++ = cviptr(readptr());
  198.         off += sizeof(NODE);
  199.         break;
  200.     case STRING:
  201.         p = cviptr(off);
  202.         p->n_type = type;
  203.         p->n_vsize = size = (int)readptr();
  204.         p->n_vdata = getvspace(p,btow_size(size));
  205.         for (cp = (unsigned char *)getstring(p); --size >= 0; )
  206.         *cp++ = osbgetc(fp);
  207.         off += sizeof(NODE);
  208.         break;
  209.     case PORT:
  210.         p = cviptr(off);
  211.         readnode(type,p);
  212.         setfile(p,NULL);
  213.         off += sizeof(NODE);
  214.         break;
  215.     case SUBR:
  216.     case XSUBR:
  217.         p = cviptr(off);
  218.         readnode(type,p);
  219.         p->n_subr = funtab[getoffset(p)].fd_subr;
  220.         off += sizeof(NODE);
  221.         break;
  222.     default:
  223.         readnode(type,cviptr(off));
  224.         off += sizeof(NODE);
  225.         break;
  226.     }
  227. done:
  228.  
  229.     /* close the input file */
  230.     osclose(fp);
  231.  
  232.     /* collect to initialize the free space */
  233.     gc();
  234.  
  235.     /* lookup all of the symbols the interpreter uses */
  236.     xlsymbols();
  237.  
  238.     /* return successfully */
  239.     return (TRUE);
  240. }
  241.  
  242. /* freeimage - free the current memory image */
  243. static VOID freeimage()
  244. {
  245.     NSEGMENT *nextnseg;
  246.     VSEGMENT *nextvseg;
  247.     FILE *fp;
  248.     LVAL p;
  249.     int n;
  250.  
  251.     /* close all open ports and free each node segment */
  252.     while (nsegments != NULL) {
  253.     nextnseg = nsegments->ns_next;
  254.     p = &nsegments->ns_data[0];
  255.     n = nsegments->ns_size;
  256.     for (; --n >= 0; ++p)
  257.         switch (ntype(p)) {
  258.         case PORT:
  259.         if ((fp = getfile(p)) != NULL
  260.          && (fp != stdin && fp != stdout && fp != stderr))
  261.             osclose(getfile(p));
  262.         break;
  263.         }
  264.     free((char *)nsegments);
  265.     nsegments = nextnseg;
  266.     }
  267.  
  268.     /* free each vector segment */
  269.     while (vsegments != NULL) {
  270.     nextvseg = vsegments->vs_next;
  271.     free((char *)vsegments);
  272.     vsegments = nextvseg;
  273.     }
  274.     
  275.     /* free the stack */
  276.     if (xlstkbase)
  277.     free((char *)xlstkbase);
  278. }
  279.  
  280. /* setoffset - output a positioning command if nodes have been skipped */
  281. static VOID setoffset()
  282. {
  283.     if (off != foff) {
  284.     osbputc(FREE,fp);
  285.     writeptr(off);
  286.     foff = off;
  287.     }
  288. }
  289.  
  290. /* writenode - write a node to a file */
  291. static VOID writenode(node)
  292.   LVAL node;
  293. {
  294.     char *p = (char *)&node->n_info;
  295.     int n = sizeof(union ninfo);
  296.     osbputc(node->n_type,fp);
  297.     while (--n >= 0)
  298.     osbputc(*p++,fp);
  299. }
  300.  
  301. /* writeptr - write a pointer to a file */
  302. static VOID writeptr(off)
  303.   OFFTYPE off;
  304. {
  305.     char *p = (char *)&off;
  306.     int n = sizeof(OFFTYPE);
  307.     while (--n >= 0)
  308.     osbputc(*p++,fp);
  309. }
  310.  
  311. /* readnode - read a node */
  312. static VOID readnode(type,node)
  313.   int type; LVAL node;
  314. {
  315.     char *p = (char *)&node->n_info;
  316.     int n = sizeof(union ninfo);
  317.     node->n_type = type;
  318.     while (--n >= 0)
  319.     *p++ = osbgetc(fp);
  320. }
  321.  
  322. /* readptr - read a pointer */
  323. static OFFTYPE readptr()
  324. {
  325.     OFFTYPE off;
  326.     char *p = (char *)&off;
  327.     int n = sizeof(OFFTYPE);
  328.     while (--n >= 0)
  329.     *p++ = osbgetc(fp);
  330.     return (off);
  331. }
  332.  
  333. /* cviptr - convert a pointer on input */
  334. static LVAL cviptr(o)
  335.   OFFTYPE o;
  336. {
  337.     NSEGMENT *newnsegment(),*nseg;
  338.     OFFTYPE off = (OFFTYPE)2;
  339.     OFFTYPE nextoff;
  340.  
  341.     /* check for nil and small fixnums */
  342.     if (o == (OFFTYPE)0 || (o & 1) == 1)
  343.     return ((LVAL)o);
  344.  
  345.     /* compute a pointer for this offset */
  346.     for (nseg = nsegments; nseg != NULL; nseg = nseg->ns_next) {
  347.     nextoff = off + (OFFTYPE)(nseg->ns_size * sizeof(NODE));
  348.     if (o >= off && o < nextoff)
  349.         return ((LVAL)((OFFTYPE)&nseg->ns_data[0] + o - off));
  350.     off = nextoff;
  351.     }
  352.  
  353.     /* create new segments if necessary */
  354.     for (;;) {
  355.  
  356.     /* create the next segment */
  357.     if ((nseg = newnsegment(NSSIZE)) == NULL)
  358.         xlfatal("insufficient memory - segment");
  359.  
  360.     /* check to see if the offset is in this segment */
  361.     nextoff = off + (OFFTYPE)(nseg->ns_size * sizeof(NODE));
  362.     if (o >= off && o < nextoff)
  363.         return ((LVAL)((OFFTYPE)&nseg->ns_data[0] + o - off));
  364.     off = nextoff;
  365.     }
  366. }
  367.  
  368. /* cvoptr - convert a pointer on output */
  369. static OFFTYPE cvoptr(p)
  370.   LVAL p;
  371. {
  372.     OFFTYPE off = (OFFTYPE)2;
  373.     NSEGMENT *nseg;
  374.  
  375.     /* check for nil and small fixnums */
  376.     if (p == NIL || !ispointer(p))
  377.     return ((OFFTYPE)p);
  378.  
  379.     /* compute an offset for this pointer */
  380.     for (nseg = nsegments; nseg != NULL; nseg = nseg->ns_next) {
  381.     if (INSEGMENT(p,nseg))
  382.         return (off + ((OFFTYPE)p - (OFFTYPE)&nseg->ns_data[0]));
  383.     off += (OFFTYPE)(nseg->ns_size * sizeof(NODE));
  384.     }
  385.  
  386.     /* pointer not within any segment */
  387.     xlerror("bad pointer found during image save",p);
  388.     return ((OFFTYPE)0); /* never reached */
  389. }
  390.  
  391. /* getvspace - allocate vector space */
  392. static LVAL *getvspace(node,size)
  393.   LVAL node; unsigned int size;
  394. {
  395.     LVAL *p;
  396.     ++size; /* space for the back pointer */
  397.     if (!VCOMPARE(vfree,size,vtop)
  398.     &&  !checkvmemory(size)
  399.     &&  !makevmemory(size))
  400.     xlfatal("insufficient vector space");
  401.     p = vfree;
  402.     vfree += size;
  403.     *p++ = node;
  404.     return (p);
  405. }
  406.