home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / IMAGE.C < prev    next >
C/C++ Source or Header  |  1990-08-13  |  8KB  |  360 lines
  1. /*
  2.  *        X PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <at@unido.uucp>
  9.  *            <....!seismo!unido!at>
  10.  *            <at@unido.bitnet>
  11.  *
  12.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  13.  *            Permission is granted hereby to copy the entire
  14.  *            package including this copyright notice without fee.
  15.  *
  16.  */
  17.  
  18. #include <stdio.h>
  19. #include "prolog.h"
  20. #include "error.h"
  21. #include "extern.h"
  22.  
  23. #define REL(x)    ((x) ? (long)(x) - (long)functorsp + 1 : (long)(x))
  24. #define DEREL(x) ((x) ? (long)(x) + (long)functorsp - 1 : (long)(x))
  25.     
  26. #ifdef VAX
  27. #define lmalloc malloc
  28. #endif
  29.  
  30. #define EVEN(x) (((long)(x) & ~(1L)) + 2)    /* make adress even */
  31.  
  32. extern char *malloc();
  33. extern char *lmalloc();
  34.  
  35. /*    make the areas relocatible */
  36.  
  37. void relocate()
  38. {
  39.     functor *f;
  40.     clause *c;
  41.     term *t;
  42.     long i;
  43.     
  44.     /* relocate all functors */
  45.     f = (functor *)functorsp;
  46.     while (f < functornext)
  47.     {
  48.         f->cp = (char *)REL(f->cp);
  49.         f->left = (functor *)REL(f->left);
  50.         f->right = (functor *)REL(f->right);
  51.         f = (functor *)((long)f + sizeof(functor) + strlen(f->name));
  52.         if ((long)f &0x1)        /* odd */
  53.             f = (functor *)((long)f + 1);
  54.     }
  55.     
  56.     /* relocate all clauses */
  57.     
  58.     c = clausesp;
  59.     while (c < clausenext)
  60.     {
  61.         c->next = (clause *)REL(c->next);
  62.         if (!ISBUILTIN(c))
  63.         {
  64.             c->head = (term *)REL(c->head);
  65.             c->body = (term *)REL(c->body);
  66.         }
  67.         c++;
  68.     }
  69.     
  70.     /* relocate all prototypes */
  71.     t = (term *)protostack;
  72.     while (t < protonext)
  73.     {
  74.         if (ISFREE(t))        /* relocate free list */
  75.         {
  76.             ARG(t,0) = (term *)REL(ARG(t,0));
  77.             t = (term *)((long)t+sizeof(term)+
  78.                 (t->flags&0xff)*sizeof(term *));
  79.             continue;
  80.         }
  81.         if (ISINT(t) || ISVAR(t))    /* noth to do */
  82.         {
  83.             t++;
  84.             continue;
  85.         }
  86.         
  87.         for (i=1; i<=ARITY(t); i++)    /* relocate args */
  88.             ARG(t,i) = (term *)REL(ARG(t,i));
  89.         ARG(t,0) = (term *)REL(ARG(t,0)); /* and functor */
  90.         t = (term *)((long)t + sizeof(term) + (i-1)*sizeof(term *));
  91.     }
  92. }
  93.  
  94. /*    Save all prolog definitions  */
  95.  
  96. short save_area();
  97.  
  98. short save_image(name)
  99. char *name;
  100. {
  101.     i_header x;
  102.     FILE *fp;
  103.     short i;
  104.  
  105. #ifdef ATARI                    /* need binary mode */
  106.     if ((fp = fopen(name, "wb")) == NULL)
  107. #else    
  108.     if ((fp = fopen(name, "w")) == NULL)
  109. #endif
  110.     {
  111.         perror("cannot save prolog image");
  112.         return(FALSE);
  113.     }
  114.     
  115.     relocate();            /* relocate the areas */    
  116.     strcpy(x.magic, MAGIC);
  117.     x.version = IMAGEVERSION;
  118.     x.i_type = IMAGETYPE;
  119.     
  120.     x.f_top = (char *)REL(functornext);
  121.     x.f_size = (long)functorfull - (long)functorsp;
  122.     x.f_tree = (functor *)REL(functors);
  123.     
  124.     x.cl_top = (clause *)REL(clausenext);
  125.     x.cl_free = (clause *)REL(clausefree);
  126.     x.cl_size = clausefull;
  127.  
  128.     x.p_top = (term *)REL(prototop);
  129.     x.p_size = (long)protofull - (long)protostack;
  130.     for (i=0; i<MAXARGS; i++)
  131.         x.p_free[i] = (term *)REL(protofree[i]);
  132.  
  133.     x.c_size = (long)copyfull - (long)copystack;
  134.     x.s_size = (long)stackfull - (long)stack;
  135.     x.t_size = trailfull;
  136.     for (i=0; i<STDFUNCTORS; i++)
  137.         x.stdf[i] = (functor *)REL(stdfunctor[i]);
  138.  
  139.     if (fwrite(&x, sizeof(i_header), 1, fp) != 1)
  140.     {
  141.         perror("cannot save image header");
  142.         exit(0);
  143.     }
  144.  
  145.     save_area(fp,functorsp, functornext);    /* save functors */
  146.     save_area(fp,clausesp, clausesp+clausefull); /* save clauses */
  147.     save_area(fp,protostack, protonext);    /* save prototypes */
  148.     if (fclose(fp))
  149.     {
  150.         perror("cannot close image");
  151.         exit(0);
  152.     }
  153.     fprintf(stderr, "X Prolog image saved\n");
  154.     exit(0);
  155. }
  156.  
  157. short save_area(fp, from, to)
  158. FILE *fp;
  159. char *from, *to;
  160. {
  161.     while (from < to)
  162.     {
  163.         if (((long)to - (long)from) < 32000)
  164.         {
  165.             fwrite(from, (unsigned)((long)to-(long)from), 1, fp);
  166.             break;
  167.         }
  168.         else
  169.             fwrite(from, 32000, 1, fp);
  170.         from += 32000;
  171.     }
  172. }
  173.  
  174. short bisave(args)
  175. term *args[];
  176. {
  177.     if (!ISATOM(args[0]))
  178.         BIERROR(EBAD);
  179.  
  180.     return(save_image(NAME(args[0])));
  181. }
  182.  
  183. /*****************************************************************************/
  184. /*    make the areas absolut */
  185.  
  186. void derelocate()
  187. {
  188.     functor *f;
  189.     clause *c;
  190.     term *t;
  191.     long i;
  192.     
  193.     /* derelocate all functors */
  194.     f = (functor *)functorsp;
  195.     while (f < functornext)
  196.     {
  197.         f->cp = (char *)DEREL(f->cp);
  198.         f->left = (functor *)DEREL(f->left);
  199.         f->right = (functor *)DEREL(f->right);
  200.         f = (functor *)((long)f + sizeof(functor) + strlen(f->name));
  201.         if ((long)f &0x1)        /* odd */
  202.             f = (functor *)((long)f + 1);
  203.     }
  204.     
  205.     /* derelocate all clauses */
  206.     c = clausesp;
  207.     while (c < clausenext)
  208.     {
  209.         c->next = (clause *)DEREL(c->next);
  210.         if (!ISBUILTIN(c))
  211.         {
  212.             c->head = (term *)DEREL(c->head);
  213.             c->body = (term *)DEREL(c->body);
  214.         }
  215.         c++;
  216.     }
  217.     
  218.     /* derelocate all prototypes */
  219.     t = (term *)protostack;
  220.     while (t < protonext)
  221.     {
  222.         if (ISFREE(t))        /* derelocate free list */
  223.         {
  224.             ARG(t,0) = (term *)DEREL(ARG(t, 0));
  225.             t = (term *)((long)t+sizeof(term)+
  226.                 (t->flags&0xff)*sizeof(term *));
  227.             continue;
  228.         }
  229.         if (ISINT(t) || ISVAR(t))    /* noth to do */
  230.         {
  231.             t++;
  232.             continue;
  233.         }
  234.         ARG(t,0) = (term *)DEREL(ARG(t, 0)); /* derelocate functor */
  235.         for (i=1; i<=ARITY(t); i++)    /* derelocate args */
  236.             ARG(t,i) = (term *)DEREL(ARG(t,i));
  237.         t = (term *)((long)t + sizeof(term) + (i-1)*sizeof(term *));
  238.     }
  239. }
  240.  
  241. short read_area();
  242.  
  243. short read_image(name)
  244. char *name;            /* the image name */
  245. {
  246.     i_header x;
  247.     FILE *fp;
  248.     short i;
  249.     long l;
  250.  
  251. #ifdef ATARI                    /* need binary mode */
  252.     if ((fp = fopen(name, "rb")) == NULL)
  253. #else    
  254.     if ((fp = fopen(name, "r")) == NULL)
  255. #endif
  256.     {
  257.         perror("cannot read prolog image");
  258.         return(FALSE);
  259.     }
  260.     if (fread(&x, sizeof(i_header), 1, fp) != 1)
  261.     {
  262.         perror("cannot read image header");
  263.         return(FALSE);
  264.     }
  265.  
  266.     if (strcmp(x.magic, MAGIC))
  267.     {
  268.         fprintf(stderr, "garbled prolog image\n");
  269.         fclose(fp);
  270.         return(FALSE);
  271.     }
  272.     if (x.version != IMAGEVERSION)
  273.     {
  274.         fprintf(stderr, "old fashion prolog image\n");
  275.         fclose(fp);
  276.         return(FALSE);
  277.     }
  278.     if (x.i_type != IMAGETYPE)
  279.     {
  280.         fprintf(stderr, "cannot unpack image on this machine\n");
  281.         fclose(fp);
  282.         return(FALSE);
  283.     }
  284.     
  285.     /* header is tested now, lets create the data space */    
  286.     l = x.f_size+x.cl_size*sizeof(clause)+x.t_size*sizeof(term *)
  287.         +x.p_size+x.c_size+x.s_size+20;
  288.  
  289.     if ((functorsp = lmalloc(l)) == NULL)
  290.         panic(NOMEMORY);
  291.         
  292.     functornext = (char *)DEREL(x.f_top);
  293.     functorfull = functorsp+x.f_size;
  294.     functors = (functor *)DEREL(x.f_tree);
  295.  
  296.     clausesp = (clause *)EVEN(functorfull);
  297.     clausefree = (clause *)DEREL(x.cl_free);
  298.     clausefull = x.cl_size;
  299.     clausenext = (clause *)DEREL(x.cl_top);
  300.  
  301.     trailstack = (term **)EVEN(clausesp + clausefull);
  302.     trailtop = 0;
  303.     trailfull = x.t_size;
  304.  
  305.     protostack = (char *)EVEN(trailstack+trailfull);
  306.     prototop = (char *)DEREL(x.p_top);
  307.     if (ISSTRUCT(prototop))
  308.         protonext = (term *)((long)prototop+sizeof(term)+
  309.                 ARITY(prototop)*sizeof(term *));
  310.     else
  311.         protonext = prototop+1;
  312.     protofull = (char *)((long)protostack + x.p_size);
  313.     for (i=0; i<=MAXARGS; i++)
  314.         protofree[i] = (term *)DEREL(x.p_free[i]);
  315.  
  316.     copystack  = (char *)EVEN(protofull);
  317.     copytop = NULL;
  318.     copynext = (term *)copystack;
  319.     copyfull = (char *)((long)copystack + x.c_size);
  320.  
  321.     stack = (char *)EVEN(copyfull);
  322.     stacktop = stack;
  323.     stackfull = stack+x.s_size;
  324.  
  325.     for (i=0; i<STDFUNCTORS; i++)
  326.         stdfunctor[i] = (functor *)DEREL(x.stdf[i]);
  327.         
  328.     Backpoint = (backlog *)0L;
  329.     Topenv = Preenv = (env *)0L;
  330.  
  331.     read_area(fp,functorsp, functornext);
  332.     read_area(fp,clausesp, clausesp+clausefull);
  333.     read_area(fp,protostack, protonext);
  334.     derelocate();
  335.     if (fclose(fp))
  336.     {
  337.         perror("cannot close image");
  338.         return(FALSE);
  339.     }
  340.     return(TRUE);
  341. }
  342.  
  343. short read_area(fp, from, to)
  344. FILE *fp;
  345. char *from, *to;
  346. {
  347.     while (from < to)
  348.     {
  349.         if (((long)to - (long)from) < 32000)
  350.         {
  351.             fread(from, (unsigned)((long)to-(long)from), 1, fp);
  352.             break;
  353.         }
  354.         else
  355.             fread(from, 32000, 1, fp);
  356.         from += 32000;
  357.     }
  358. }
  359.  
  360.