home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / fp / ifp_unix.lzh / ifp / interp / list.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-05-23  |  10.3 KB  |  459 lines

  1.  
  2. /****** list.c ********************************************************/
  3. /**                                                                  **/
  4. /**                    University of Illinois                        **/
  5. /**                                                                  **/
  6. /**                Department of Computer Science                    **/
  7. /**                                                                  **/
  8. /**   Tool: IFP                         Version: 0.5                 **/
  9. /**                                                                  **/
  10. /**   Author:  Arch D. Robison          Date:   May 1, 1985          **/
  11. /**                                                                  **/
  12. /**   Revised by: Arch D. Robison       Date:  Jan 15, 1986          **/
  13. /**                                                                  **/
  14. /**   Principal Investigators: Prof. R. H. Campbell                  **/
  15. /**                            Prof. W. J. Kubitz                    **/
  16. /**                                                                  **/
  17. /**                                                                  **/
  18. /**------------------------------------------------------------------**/
  19. /**   (C) Copyright 1987  University of Illinois Board of Trustees   **/
  20. /**                       All Rights Reserved.                       **/
  21. /**********************************************************************/
  22.  
  23. #include <stdio.h>
  24. #include "struct.h"
  25. #include "node.h"
  26. #include "umax.h"
  27. #include "string.h"
  28. #include "stats.h"
  29.  
  30. /* 
  31.  * FreeList
  32.  *
  33.  * ListCells in free-list always contain:
  34.  *
  35.  *      LRef == LRefOne 
  36.  *      Val.Tag == BOTTOM
  37.  *      Next == pointer to next cell in free list.
  38.  */
  39. ListPtr FreeList = NULL;
  40. #define LRefAdd(P,Delta) ((P)->LRef+=(Delta))
  41.  
  42. /*************** Fundamental List Manipulation Routines ***************/
  43.  
  44. private ListPtr FixCopyLPtr ();         /* forward reference */
  45.  
  46. /*
  47.  * Rot3
  48.  */
  49. void Rot3 (A,B,C)
  50.    MetaPtr A,B,C;
  51.    {
  52.       register ListPtr P;
  53.       P = *A; *A = *B; *B = *C; *C = P;
  54.    }
  55.  
  56. /*
  57.  * ListLength
  58.  *
  59.  * Input
  60.  *      P = pointer to list
  61.  *
  62.  * Output
  63.  *      result = length of list
  64.  */
  65. long ListLength (P)
  66.    register ListPtr P;
  67.    {
  68.       register long N;
  69.       for (N=0; P!=NULL; P=P->Next) N++;
  70.       return N;
  71.    }
  72.  
  73. /*
  74.  * CopyObject
  75.  *
  76.  * Copy object: X := Y
  77.  *
  78.  * A SysError may occur.
  79.  */
  80. void CopyObject (X,Y)
  81.    ObjectPtr X,Y;
  82.    {
  83.       register ListPtr P;
  84.  
  85.       switch (X->Tag = Y->Tag) {
  86.      case BOTTOM: break;
  87.      case BOOLEAN: X->Bool   = Y->Bool;              break;
  88.      case INT:     X->Int    = Y->Int;               break;
  89.      case FLOAT:   X->Float  = Y->Float;             break;
  90.      case LIST:
  91.          /* CopyLPtr expanded inline for speed */
  92.          P = Y->List;
  93.          if (P!=NULL && LRefAdd (P,1) == LRefOne-1) 
  94.         /*
  95.          * This won't work for multiprocessor version
  96.          * since other processors will not detect overflow.
  97.          */
  98.         P = FixCopyLPtr (P);
  99.          X->List = P;
  100.          break;
  101.      case STRING:  X->String = CopySPtr (Y->String);        break;
  102.      case NODE:    X->Node   = CopyNPtr (Y->Node);      break;
  103.       }
  104.    }
  105.  
  106. /*
  107.  * NewList
  108.  *
  109.  * Point *A to list of N cells with last cell's Next set to old value of *A.
  110.  *
  111.  * Each cell value is set to BOTTOM
  112.  *
  113.  * A SysError may occur, in which case *A remains unchanged.
  114.  *
  115.  * Implementation note: 
  116.  *     (x >= 0) is faster than (x > 0) on 16-bit machines since only
  117.  *     the sign bit must be checked.
  118.  */
  119. void NewList (A,N)
  120.    MetaPtr A;
  121.    register long N;
  122.    {
  123.       extern ListPtr AllocListPage ();
  124.       register MetaPtr B;
  125.       ListPtr P;
  126.  
  127.       Stat (StatNewList (N));
  128.       if (--N >= 0) {
  129.      B = &FreeList;
  130.      do {
  131.         if (*B == NULL && (*B = AllocListPage ()) == NULL) {
  132.            SysError = NO_LIST_FREE;
  133.            printf ("NO MORE LIST CELLS LEFT\n");
  134.            return;
  135.         }
  136.         B = &(*B)->Next;
  137.      } while (--N >= 0);
  138.      P = FreeList;
  139.      FreeList = *B;
  140.      *B = *A;
  141.      *A = P;
  142.       }
  143.    }
  144.  
  145. /*
  146.  * Repeat
  147.  *
  148.  * Create a new list containing N copies of an object
  149.  *
  150.  * Output
  151.  *      result = pointer to list
  152.  *
  153.  * A SysError may occur, in which case NULL is returned.
  154.  */
  155. ListPtr Repeat (X,N)
  156.    register ObjectPtr X; 
  157.    long N;
  158.    {
  159.       ListPtr P=NULL;
  160.       register ListPtr Q;
  161.  
  162.       NewList (&P,N);
  163.       if (!SysError)
  164.      for (Q=P; Q!=NULL; Q=Q->Next) 
  165.         CopyObject (&Q->Val,X); 
  166.       return P;
  167.    }
  168.  
  169. /*
  170.  * DelLPtr
  171.  *
  172.  * Delete a list pointer: decrement reference count and return to free-list
  173.  *                        if not used anymore.
  174.  *
  175.  * Routine is "vectorized" in that it is optimized to return long lists
  176.  * to the freelist.
  177.  */
  178. void DelLPtr (P)
  179.    register ListPtr P;
  180.    {
  181.       register ListPtr Q,R;
  182.  
  183.       Stat (StatDelLPtr (P));
  184.  
  185.       for (R=P; R!=NULL; R=R->Next) {
  186.          if (R->LRef != LRefOne) {
  187.         R->LRef--;
  188.         break;
  189.      }
  190.      if (!Scalar (R->Val.Tag)) {
  191.         switch (R->Val.Tag) {
  192.            case LIST:     DelLPtr (R->Val.List);     break;
  193.            case STRING:   DelSPtr (R->Val.String);   break;
  194.            case NODE:     DelNPtr (R->Val.Node);     break;
  195.         }
  196.         R->Val.Tag = BOTTOM;
  197.      }
  198.      Q = R;
  199.       }
  200.       if (R != P) {
  201.      Q->Next = FreeList; 
  202.      FreeList = P;
  203.       }
  204.    }
  205.  
  206. /*
  207.  * CopyLPtr
  208.  *
  209.  * Make a copy of a list pointer, incrementing the reference count.
  210.  * If the reference count would overflow, a new list cell is generated.
  211.  *
  212.  * A SysError may occur, in which case the result is NULL.
  213.  */
  214. ListPtr CopyLPtr (P)
  215.    ListPtr P;
  216.    {
  217.       if (P!=NULL) {
  218.          if (LRefAdd (P,1) == LRefOne-1) {
  219.             return FixCopyLPtr (P);
  220.          }
  221.       }
  222.       return P;
  223.    }
  224.  
  225. /*
  226.  * FixCopyLPtr 
  227.  * 
  228.  * Copy a list pointer which overflowed.
  229.  *
  230.  * Input
  231.  *    P = pointer to list cell
  232.  */
  233. private ListPtr FixCopyLPtr (P)
  234.    ListPtr P;
  235.    {
  236.       ListPtr Q;                        /* Reference count overflowed */
  237.  
  238.       LRefAdd (P,-1);
  239.       Q = CopyLPtr (P->Next);
  240.       if (SysError) return NULL;
  241.       NewList (&Q,1L);
  242.       if (SysError) return NULL;
  243.       CopyObject (&Q->Val,&P->Val);
  244.       return Q;
  245.    }
  246.  
  247. /*
  248.  * RepTag
  249.  *
  250.  * Replace an object tag with another tag.
  251.  */
  252. void RepTag (Dest,NewTag)
  253.    ObjectPtr Dest;
  254.    char NewTag;
  255.    {
  256.       switch (Dest->Tag) {
  257.      case LIST:     DelLPtr (Dest->List);       break;
  258.      case STRING:   DelSPtr (Dest->String);     break;
  259.      case NODE:     DelNPtr (Dest->Node);       break;
  260.      /* default: break; */
  261.       }
  262.       Dest->Tag = NewTag;
  263.    }
  264.  
  265. /*
  266.  * RepBool
  267.  *
  268.  * Replace an object with a boolean object
  269.  */
  270. void RepBool (Dest,Value)
  271.    ObjectPtr Dest;
  272.    boolean Value;
  273.    {
  274.       RepTag (Dest,BOOLEAN);
  275.       Dest->Bool = Value;
  276.    }
  277.  
  278. /*
  279.  * RepObject
  280.  *
  281.  * Replace an Object by another Object.
  282.  *
  283.  * A SysError may occur.
  284.  */
  285. boolean RepObject (Y,X)
  286.    register ObjectPtr Y,X;
  287.    {
  288.       Object Z;
  289.  
  290.       switch (Z.Tag = Y->Tag) {
  291.      case LIST:   Z.List   = Y->List;   break;
  292.      case STRING: Z.String = Y->String; break;
  293.      case NODE:   Z.Node   = Y->Node;   break;
  294.       }
  295.       switch (Y->Tag = X->Tag) {
  296.      case BOTTOM:    break;
  297.      case BOOLEAN:   Y->Bool   = X->Bool;              break;
  298.      case INT:       Y->Int    = X->Int;               break;
  299.      case FLOAT:     Y->Float  = X->Float;             break;
  300.      case LIST:      Y->List   = CopyLPtr (X->List);   break;
  301.      case STRING:    Y->String = CopySPtr (X->String); break;
  302.      case NODE:      Y->Node   = CopyNPtr (X->Node);   break;
  303.       }
  304.       switch (Z.Tag) {
  305.      case LIST:   DelLPtr (Z.List);   break;
  306.      case STRING: DelSPtr (Z.String); break;
  307.      case NODE:   DelNPtr (Z.Node);   break;
  308.       }
  309.    }
  310.  
  311.  
  312. /*
  313.  * RepLPtr
  314.  *
  315.  * Replace pointer variable *A by value B.
  316.  *
  317.  * A SysError may occur, in which case *A remains unchanged.
  318.  */
  319. void RepLPtr (A,P)
  320.    MetaPtr A; 
  321.    ListPtr P;
  322.    {
  323.       P = CopyLPtr (P); /* Copy P first so DelLPtr can't trash *P */
  324.       if (SysError) return;
  325.       DelLPtr (*A);
  326.       *A = P;
  327.    }
  328.  
  329.  
  330. /*
  331.  * MakeCopy
  332.  *
  333.  * Make a copy of a non-empty list.
  334.  *
  335.  * Input
  336.  *      P = pointer to list
  337.  *
  338.  * Output
  339.  *      *A = pointer to identical list with LRef == LRefOne
  340.  *      result = metapointer to Next field of end of result list
  341.  *
  342.  * A SysError may occur, in which case *A remains unchanged.
  343.  *
  344.  * All sublist-head reference-counts are incremented if no error occurs.
  345.  */
  346. MetaPtr MakeCopy (A,P)
  347.    register ListPtr *A,P;
  348.    {
  349.       register ListPtr Q;
  350.       ListPtr R=NULL;         /* R = root of new list */
  351.  
  352.       NewList (&R,ListLength (P));
  353.       if (SysError) return NULL;
  354.  
  355.       Q = R;
  356.       while (1) {
  357.      if (Scalar (P->Val.Tag)) {
  358.         Q->Val.Data = P->Val.Data;
  359.         Q->Val.Tag  = P->Val.Tag;
  360.      } else {
  361.         CopyObject (& Q->Val,& P->Val);
  362.         if (SysError) {DelLPtr (R); return NULL;};
  363.      }
  364.      P = P->Next;
  365.      if (P == NULL) break;
  366.      Q = Q->Next;
  367.       };
  368.  
  369.       *A = R;
  370.       return &Q->Next;
  371.    }
  372.  
  373.  
  374. /*
  375.  * CopyTop
  376.  *
  377.  * Replace *A with a pointer to a fresh (top level) copy of *A.
  378.  *
  379.  * Input
  380.  *      *A = pointer to list
  381.  * Output
  382.  *      *A = pointer to identical list with LRef == LRefOne for top level
  383.  *
  384.  * A SysError may occur, in which case *A remains unchanged.
  385.  */
  386. void CopyTop (A)
  387.    register MetaPtr A;
  388.    {
  389.       register ListPtr P;
  390.  
  391.       while (1) {                 /* Search for shared part of list */
  392.      P = *A;
  393.      if (P == NULL) return;
  394.      if (P->LRef != LRefOne) break;
  395.      Stat (StatRecycle++);
  396.      A = & P->Next;
  397.       }
  398.  
  399.       (void) MakeCopy (A,P);
  400.       P->LRef--;
  401.       if (SysError) (*A)->LRef++;
  402.    }
  403.  
  404.  
  405. /*
  406.  * Copy2Top
  407.  *
  408.  * Replace *A with a pointer to a fresh (top 2 levels) of *A.
  409.  *
  410.  * Input
  411.  *      *A = pointer to list
  412.  * Output
  413.  *      *A = pointer to identical list with LRef == LRefOne
  414.  *           for both top level and any immediate sublists.
  415.  *
  416.  * A SysError may occur, in which case *A remains unchanged.
  417.  */
  418. void Copy2Top (A)
  419.    register MetaPtr A;
  420.    {
  421.       register ListPtr P;
  422.  
  423.       while (1) {                 /* Search for shared part of list */
  424.      P = *A;
  425.      if (P == NULL) return;
  426.      if (P->LRef != LRefOne) break;
  427.      if (P->Val.Tag == LIST) {
  428.         CopyTop (&P->Val.List);
  429.         if (SysError) return;
  430.      }
  431.      Stat (StatRecycle++);
  432.      A = & P->Next;
  433.       }
  434.  
  435.       /* (*A) now points to shared list */
  436.  
  437.       (void) MakeCopy (A,(P = *A));
  438.  
  439.       if (SysError) return;
  440.       P->LRef--;
  441.       P = *A;
  442.  
  443.       do
  444.      if (P->Val.Tag == LIST && *(A = &P->Val.List) != NULL) {
  445.         /*
  446.          * There must some more elegant way to efficiently merge these 
  447.          * two cases.
  448.          */
  449.         (*A)->LRef--; /* will be incremented by MakeCopy */
  450.             (void) MakeCopy (A,*A);
  451.         if (SysError) return;
  452.      }
  453.       while ((P=P->Next) != NULL);
  454.    }
  455.  
  456.  
  457. /****************************** end of list.c ******************************/
  458.  
  459.