home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / MEMORY.C < prev    next >
C/C++ Source or Header  |  1990-08-13  |  7KB  |  301 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 "prolog.h"
  19. #include "error.h"
  20. #include "extern.h"
  21.  
  22. #ifdef VAX
  23. #define lmalloc malloc
  24. #endif
  25.  
  26. #define EVEN(x) (((long)(x) & ~(1L)) + 2)    /* make adress even */
  27.  
  28. extern char *malloc();
  29. extern char *lmalloc();
  30.  
  31. extern void panic();        /* error */
  32.  
  33. term **top_trail();        /* forward */
  34.  
  35. /*****************************************************************************/
  36. /*        Allocation of all data areas                     */
  37. /*****************************************************************************/
  38.  
  39. void alloc_area(fu, cl, tr, pr, cp, st)
  40. long fu,cl,tr,pr,cp,st;
  41. {
  42.     long overall;
  43.     long i;
  44.     
  45.     overall = fu+cl*sizeof(clause)+tr*sizeof(term *)+pr+cp+st+20;
  46.           
  47.     if ((functorsp = lmalloc(overall)) == NULL)
  48.         panic(NOMEMORY);
  49.         
  50.     functornext = functorsp;
  51.     functorfull = functorsp+fu;
  52.  
  53.     clausesp = (clause *)EVEN(functorfull);
  54.     clausefree = (clause *)0L;
  55.     clausefull = cl;
  56.     clausenext = clausesp;
  57.  
  58.     trailstack = (term **)EVEN(clausesp + cl);
  59.     trailtop = 0L;
  60.     trailfull = tr;
  61.  
  62.     protostack = (char *)EVEN(trailstack+tr);
  63.     prototop = NULL;
  64.     protonext = (term *)protostack;
  65.     protofull = (char *)((long)protostack + pr);
  66.     for (i=0; i<=MAXARGS; i++)
  67.         protofree[i] = (term *)0L;
  68.  
  69.     copystack  = (char *)EVEN(protofull);
  70.     copytop = NULL;
  71.     copynext = (term *)copystack;
  72.     copyfull = (char *)((long)copystack + cp);
  73.  
  74.     stack = (char *)EVEN(copyfull);
  75.     stacktop = stack;
  76.     stackfull = stack+st;
  77.     
  78.     Backpoint = (backlog *)0L;
  79.     Topenv = Preenv = (env *)0L;
  80. }
  81.  
  82. /*****************************************************************************/
  83. /*        FUNCTORS                             */
  84. /*****************************************************************************/
  85.  
  86. functor *make_functor(name)
  87. char *name;
  88. {
  89.     functor *f;
  90.     short i;
  91.     
  92.     i = sizeof(functor)+strlen(name);
  93.     if ((long)functornext+i > (long)functorfull)
  94.         panic(FUNCTORFULL);
  95.     f = (functor *)functornext;
  96.     strcpy(f->name, name);
  97.     functornext += i;
  98.     if ((long)functornext & 0x1)        /* odd address */
  99.         functornext++;
  100.     return(f);
  101. }
  102.  
  103. /******************************************************************************/
  104. /*            TERMS                              */
  105. /******************************************************************************/
  106.  
  107. term *push_proto(nargs)
  108. short nargs;
  109. {
  110.     if (protofree[nargs])            /* got a used element */
  111.     {
  112.         term *t;
  113.         
  114.         t = protofree[nargs];
  115.         protofree[nargs] = ARG(t,0);    /* unlink first free */
  116.         return(t);
  117.     }
  118.     prototop = protonext;            /* make new element */
  119.     protonext = (term *) ((long)protonext + sizeof(term) +
  120.             nargs*sizeof(term *));
  121.     if ((long)protonext > (long)protofull)
  122.         panic(PROTOFULL);
  123.     return(prototop);
  124. }
  125.  
  126. term *push_copy(nargs)
  127. short nargs;
  128. {
  129.     copytop = copynext;            /* make new element */
  130.     copynext = (term *) ((long)copynext + sizeof(term) +
  131.                 nargs*sizeof(term *));
  132.     if ((long)copynext > (long)copyfull)
  133.         panic(COPYFULL);
  134.     return(copytop);
  135. }
  136.  
  137. void reclaim_proto(t)            /* put t in freelist */
  138. term *t;
  139. {
  140.     short i=0;
  141.     
  142.     if (ISSTRUCT(t))        /* got arguments */
  143.     {
  144.         for (i=1; i<=ARITY(t); i++)
  145.             reclaim_proto(ARG(t,i));
  146.         i = ARITY(t);
  147.     }
  148.     ARG(t,0) = protofree[i];    /* link to free list */
  149.     t->flags = i|FREE;
  150.     protofree[i] = t;
  151. }
  152.  
  153. void pop_copies(t)
  154. term *t;
  155. {
  156.     copytop = t;
  157.     if (ISSTRUCT(t))
  158.         copynext = (term *) ((long)copytop + sizeof(term) +
  159.                 ARITY(copytop)*sizeof(term *));
  160.     else
  161.         copynext = (term *) ((long)copytop + sizeof(term));
  162. }
  163.  
  164.  
  165. /*****************************************************************************/
  166. /*            BACKTRACK STACK                         */
  167. /*****************************************************************************/
  168.  
  169. void push_back(c)
  170. char *c;
  171. {
  172.     register backlog *b;
  173.  
  174.     if (stacktop+sizeof(backlog) > stackfull)
  175.         panic(STACKFULL);
  176.     
  177.     b = (backlog *)stacktop;
  178.     stacktop += sizeof(backlog);
  179.  
  180.     b->frozen_env = Topenv;     /* the frozen enviroment */
  181.     b->resume = c;            /* where to start next time */
  182.     b->copylev = copytop;        /* locked bejond */
  183.     b->traillev= trailtop;        /* remember for later use */
  184.     b->pre = Backpoint;        /* set stack link */
  185.     Backpoint = b;
  186. }
  187.  
  188. /*****************************************************************************/
  189. /*            ENVIROMENT STACK                     */
  190. /*****************************************************************************/
  191.  
  192. void push_env(a, t)
  193. env *a;                /* the ancestor enviroment */
  194. term *t;            /* the current term */
  195. {
  196.     register env *e;
  197.  
  198.     if (stacktop+sizeof(env) > stackfull)
  199.         panic(STACKFULL);    
  200.     
  201.     e = Topenv = (env *)stacktop;
  202.     stacktop += sizeof(env);
  203.     
  204.     e->pre = a;
  205.     e->current = t;
  206.     Preenv = a;
  207. }
  208.  
  209. /*****************************************************************************/
  210. /*            TRAIL STACK                         */
  211. /*****************************************************************************/
  212.  
  213. void pop_trails(t)
  214. long t;
  215. {
  216.     while (trailtop != t)
  217.         REF(trailstack[--trailtop]) = FREEVAR;
  218. }
  219.  
  220. /* remove all trails, that lie outside the currently frozen stacks */
  221.  
  222. void demolish_trails(t)
  223. long t;
  224. {
  225.     long i;
  226.     
  227.     for (i=t; i<trailtop; i++)
  228.         if ((long)trailstack[i] <= (long)Backpoint->copylev ||
  229.            (long)trailstack[i]<(long)Backpoint)
  230.             trailstack[t++] = trailstack[i];
  231.     trailtop = t;
  232. }
  233.  
  234. /*****************************************************************************/
  235. /*            FRAME VAR STACK                         */
  236. /*****************************************************************************/
  237.  
  238. void push_frame(e,n)
  239. register env *e;        /* the frame belongs to e */
  240. register short n;        /* how many vars in that frame */
  241. {
  242.     register term *p;
  243.  
  244.     if (stacktop+n*sizeof(term) > stackfull)
  245.         panic(STACKFULL);    
  246.  
  247.     p = (term *)stacktop;
  248.     stacktop += n*sizeof(term);
  249.  
  250.     e->frame = p;                /* enter frame and # */    
  251.     e->nvars = n;
  252.     while (n--)                /* init the frame */
  253.     {
  254.         p->flags = VAR;
  255.         REF(p) = FREEVAR;
  256.         p += 1;                /* skip to next term */
  257.     }
  258. }
  259.  
  260. /*****************************************************************************/
  261. /*            CLAUSE SPACE                         */
  262. /*****************************************************************************/
  263.  
  264. clause *make_clause(flags, head, tail, n)
  265. short flags, n;
  266. term *head,*tail;
  267. {
  268.     register clause *c;
  269.     
  270.     if (clausefree)            /* got some free clauses in list */
  271.     {
  272.         c = clausefree;
  273.         clausefree = clausefree->next;
  274.     }
  275.     else
  276.     {
  277.         if ((long)(clausesp+clausefull) < (long)clausenext)
  278.             panic(CLAUSEFULL);
  279.         c = clausenext;
  280.         clausenext++;
  281.     }
  282.     c->flags = flags;
  283.     c->head = head;
  284.     c->body = tail;
  285.     c->nvars = n;
  286.     c->next = NULL;
  287.     return(c);
  288. }
  289.  
  290. void remove_clause(c)
  291. clause *c;
  292. {
  293.     if (!ISBUILTIN(c))
  294.     {
  295.         reclaim_proto(c->head);
  296.         reclaim_proto(c->body);
  297.     }
  298.     c->next = clausefree;
  299.     clausefree = c;
  300. }
  301.