home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispplu / xlisp2tc / xlimage.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-03-25  |  9.1 KB  |  395 lines
  1. /* xlimage - xlisp memory image save/restore functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. #ifdef SAVERESTORE
  9.  
  10. /* external variables */
  11. extern LVAL obarray,xlenv,xlfenv,xldenv,s_gchook,s_gcflag;
  12. extern long nnodes,nfree,total;
  13. extern int anodes,nsegs,gccalls;
  14. extern struct segment *segs,*lastseg,*fixseg,*charseg;
  15. extern CONTEXT *xlcontext;
  16. extern LVAL fnodes;
  17.  
  18. /* local variables */
  19. static OFFTYPE off,foff;
  20. static FILE *fp;
  21.  
  22. /* external procedures */
  23. extern SEGMENT *newsegment();
  24. extern FILE *osbopen();
  25.  
  26. /* forward declarations */
  27. #ifdef PROTOTYPES
  28. LOCAL(OFFTYPE) readptr( void ) ;
  29. LOCAL(OFFTYPE) cvoptr(LVAL) ;
  30. LOCAL(LVAL) cviptr(OFFTYPE) ;
  31. LOCAL(void) writeptr(OFFTYPE) ;
  32. LOCAL(void) setoffset(void) ;
  33. LOCAL(void) writenode(LVAL) ;
  34. LOCAL(void) freeimage(void) ;
  35. LOCAL(void) readnode(int,LVAL) ;
  36. #else
  37. FORWARD OFFTYPE readptr();
  38. FORWARD OFFTYPE cvoptr();
  39. FORWARD LVAL cviptr();
  40. FORWARD void writeptr();
  41. FORWARD void setoffset();
  42. FORWARD void writenode();
  43. FORWARD void freeimage();
  44. FORWARD void readnode();
  45. #endif PROTOTYPES
  46.  
  47. /* xlisave - save the memory image */
  48. int xlisave(fname)
  49.   char *fname;
  50. {
  51.     char fullname[STRMAX+1];
  52.     unsigned char *cp;
  53.     SEGMENT *seg;
  54.     int n,i,max;
  55.     LVAL p;
  56.  
  57.     /* default the extension */
  58.     if (needsextension(fname)) {
  59.     strcpy(fullname,fname);
  60.     strcat(fullname,".wks");
  61.     fname = fullname;
  62.     }
  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 pointer to the *obarray* symbol */
  72.     writeptr(cvoptr(obarray));
  73.  
  74.     /* setup the initial file offsets */
  75.     off = foff = (OFFTYPE)2;
  76.  
  77.     /* write out all nodes that are still in use */
  78.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  79.     p = &seg->sg_nodes[0];
  80.     for (n = seg->sg_size; --n >= 0; ++p, off += 2)
  81.         switch (ntype(p)) {
  82.         case FREE:
  83.         break;
  84.         case CONS:
  85.         case USTREAM:
  86.         setoffset();
  87.         osbputc(p->n_type,fp);
  88.         writeptr(cvoptr(car(p)));
  89.         writeptr(cvoptr(cdr(p)));
  90.         foff += 2;
  91.         break;
  92.         default:
  93.         setoffset();
  94.         writenode(p);
  95.         break;
  96.         }
  97.     }
  98.  
  99.     /* write the terminator */
  100.     osbputc(FREE,fp);
  101.     writeptr((OFFTYPE)0);
  102.  
  103.     /* write out data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
  104.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  105.     p = &seg->sg_nodes[0];
  106.     for (n = seg->sg_size; --n >= 0; ++p)
  107.         switch (ntype(p)) {
  108.         case SYMBOL:
  109.         case OBJECT:
  110.         case VECTOR:
  111.         case CLOSURE:
  112.         max = getsize(p);
  113.         for (i = 0; i < max; ++i)
  114.             writeptr(cvoptr(getelement(p,i)));
  115.         break;
  116.         case STRING:
  117.         max = getslength(p);
  118.         for (cp = getstring(p); --max >= 0; )
  119.             osbputc(*cp++,fp);
  120.         break;
  121.         }
  122.     }
  123.  
  124.     /* close the output file */
  125.     osclose(fp);
  126.  
  127.     /* return successfully */
  128.     return (TRUE);
  129. }
  130.  
  131. /* xlirestore - restore a saved memory image */
  132. int xlirestore(fname)
  133.   char *fname;
  134. {
  135.     extern FUNDEF funtab[];
  136.     char fullname[STRMAX+1];
  137.     unsigned char *cp;
  138.     int n,i,max,type;
  139.     SEGMENT *seg;
  140.     LVAL p;
  141.  
  142.     /* default the extension */
  143.     if (needsextension(fname)) {
  144.     strcpy(fullname,fname);
  145.     strcat(fullname,".wks");
  146.     fname = fullname;
  147.     }
  148.  
  149.     /* open the file */
  150.     if ((fp = osbopen(fname,"r")) == NULL)
  151.     return (FALSE);
  152.  
  153.     /* free the old memory image */
  154.     freeimage();
  155.  
  156.     /* initialize */
  157.     off = (OFFTYPE)2;
  158.     total = nnodes = nfree = 0L;
  159.     fnodes = NIL;
  160.     segs = lastseg = NULL;
  161.     nsegs = gccalls = 0;
  162.     xlenv = xlfenv = xldenv = s_gchook = s_gcflag = NIL;
  163.     xlstack = xlstkbase + EDEPTH;
  164.     xlcontext = NULL;
  165.  
  166.     /* create the fixnum segment */
  167.     if ((fixseg = newsegment(SFIXSIZE)) == NULL)
  168.     xlfatal("insufficient memory - fixnum segment");
  169.  
  170.     /* create the character segment */
  171.     if ((charseg = newsegment(CHARSIZE)) == NULL)
  172.     xlfatal("insufficient memory - character segment");
  173.  
  174.     /* read the pointer to the *obarray* symbol */
  175.     obarray = cviptr(readptr());
  176.  
  177.     /* read each node */
  178.     while ((type = osbgetc(fp)) >= 0)
  179.     switch (type) {
  180.     case FREE:
  181.         if ((off = readptr()) == (OFFTYPE)0)
  182.         goto done;
  183.         break;
  184.     case CONS:
  185.     case USTREAM:
  186.         p = cviptr(off);
  187.         p->n_type = type;
  188.         p->n_flags = 0;
  189.         rplaca(p,cviptr(readptr()));
  190.         rplacd(p,cviptr(readptr()));
  191.         off += 2;
  192.         break;
  193.     default:
  194.         readnode(type,cviptr(off));
  195.         off += 2;
  196.         break;
  197.     }
  198. done:
  199.  
  200.     /* read the data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
  201.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  202.     p = &seg->sg_nodes[0];
  203.     for (n = seg->sg_size; --n >= 0; ++p)
  204.         switch (ntype(p)) {
  205.         case SYMBOL:
  206.         case OBJECT:
  207.         case VECTOR:
  208.         case CLOSURE:
  209.         max = getsize(p);
  210.         if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  211.             xlfatal("insufficient memory - vector");
  212.         total += (long)(max * sizeof(LVAL));
  213.         for (i = 0; i < max; ++i)
  214.             setelement(p,i,cviptr(readptr()));
  215.         break;
  216.         case STRING:
  217.         max = getslength(p);
  218.         if ((p->n_string = (unsigned char *)malloc(max)) == NULL)
  219.             xlfatal("insufficient memory - string");
  220.         total += (long)max;
  221.         for (cp = getstring(p); --max >= 0; )
  222.             *cp++ = osbgetc(fp);
  223.         break;
  224.         case STREAM:
  225.         setfile(p,NULL);
  226.         break;
  227.         case SUBR:
  228.         case FSUBR:
  229.         p->n_subr = funtab[getoffset(p)].fd_subr;
  230.         break;
  231.         }
  232.     }
  233.  
  234.     /* close the input file */
  235.     osclose(fp);
  236.  
  237.     /* collect to initialize the free space */
  238.     gc();
  239.  
  240.     /* lookup all of the symbols the interpreter uses */
  241.     xlsymbols();
  242.  
  243.     /* return successfully */
  244.     return (TRUE);
  245. }
  246.  
  247. /* freeimage - free the current memory image */
  248. LOCAL(void) freeimage()
  249. {
  250.     SEGMENT *seg,*next;
  251.     FILE *fp;
  252.     LVAL p;
  253.     int n;
  254.  
  255.     /* free the data portion of SYMBOL/VECTOR/OBJECT/STRING nodes */
  256.     for (seg = segs; seg != NULL; seg = next) {
  257.     p = &seg->sg_nodes[0];
  258.     for (n = seg->sg_size; --n >= 0; ++p)
  259.         switch (ntype(p)) {
  260.         case SYMBOL:
  261.         case OBJECT:
  262.         case VECTOR:
  263.         case CLOSURE:
  264.         if (p->n_vsize)
  265.             free(p->n_vdata);
  266.         break;
  267.         case STRING:
  268.         if (getslength(p))
  269.             free(getstring(p));
  270.         break;
  271.         case STREAM:
  272.         if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  273.             osclose(getfile(p));
  274.         break;
  275.         }
  276.     next = seg->sg_next;
  277.     free(seg);
  278.     }
  279. }
  280.  
  281. /* setoffset - output a positioning command if nodes have been skipped */
  282. LOCAL(void) setoffset()
  283. {
  284.     if (off != foff) {
  285.     osbputc(FREE,fp);
  286.     writeptr(off);
  287.     foff = off;
  288.     }
  289. }
  290.  
  291. /* writenode - write a node to a file */
  292. LOCAL(void) writenode(node)
  293.   LVAL node;
  294. {
  295.     char *p = (char *)&node->n_info;
  296.     int n = sizeof(union ninfo);
  297.     osbputc(node->n_type,fp);
  298.     while (--n >= 0)
  299.     osbputc(*p++,fp);
  300.     foff += 2;
  301. }
  302.  
  303. /* writeptr - write a pointer to a file */
  304. LOCAL(void) writeptr(off)
  305.   OFFTYPE off;
  306. {
  307.     char *p = (char *)&off;
  308.     int n = sizeof(OFFTYPE);
  309.     while (--n >= 0)
  310.     osbputc(*p++,fp);
  311. }
  312.  
  313. /* readnode - read a node */
  314. LOCAL(void) readnode(type,node)
  315.   int type; LVAL node;
  316. {
  317.     char *p = (char *)&node->n_info;
  318.     int n = sizeof(union ninfo);
  319.     node->n_type = type;
  320.     node->n_flags = 0;
  321.     while (--n >= 0)
  322.     *p++ = osbgetc(fp);
  323. }
  324.  
  325. /* readptr - read a pointer */
  326. LOCAL(OFFTYPE) readptr()
  327. {
  328.     OFFTYPE off;
  329.     char *p = (char *)&off;
  330.     int n = sizeof(OFFTYPE);
  331.     while (--n >= 0)
  332.     *p++ = osbgetc(fp);
  333.     return (off);
  334. }
  335.  
  336. /* cviptr - convert a pointer on input */
  337. LOCAL(LVAL) cviptr(o)
  338.   OFFTYPE o;
  339. {
  340.     OFFTYPE off = (OFFTYPE)2;
  341.     SEGMENT *seg;
  342.  
  343.     /* check for nil */
  344.     if (o == (OFFTYPE)0)
  345.     return ((LVAL)o);
  346.  
  347.     /* compute a pointer for this offset */
  348.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  349.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  350.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  351.     off += (OFFTYPE)(seg->sg_size << 1);
  352.     }
  353.  
  354.     /* create new segments if necessary */
  355.     for (;;) {
  356.  
  357.     /* create the next segment */
  358.     if ((seg = newsegment(anodes)) == NULL)
  359.         xlfatal("insufficient memory - segment");
  360.  
  361.     /* check to see if the offset is in this segment */
  362.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  363.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  364.     off += (OFFTYPE)(seg->sg_size << 1);
  365.     }
  366. }
  367.  
  368. /* cvoptr - convert a pointer on output */
  369. LOCAL(OFFTYPE) cvoptr(p)
  370.   LVAL p;
  371. {
  372.     OFFTYPE off = (OFFTYPE)2;
  373.     SEGMENT *seg;
  374.  
  375.     /* check for nil and small fixnums */
  376.     if (p == NIL)
  377.     return ((OFFTYPE)p);
  378.  
  379.     /* compute an offset for this pointer */
  380.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  381.     if (CVPTR(p) >= CVPTR(&seg->sg_nodes[0]) &&
  382.         CVPTR(p) <  CVPTR(&seg->sg_nodes[0] + seg->sg_size))
  383.         return (off + (OFFTYPE)((p - seg->sg_nodes) << 1));
  384.     off += (OFFTYPE)(seg->sg_size << 1);
  385.     }
  386.  
  387.     /* pointer not within any segment */
  388.     xlerror("bad pointer found during image save",p);
  389.     /* keep LINT happy by returning something */
  390.     return ((OFFTYPE)NIL) ;
  391. }
  392.  
  393. #endif
  394.  
  395.