home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / xlisp / xlisp12.ark / XLSYM.C < prev    next >
Encoding:
C/C++ Source or Header  |  1985-02-20  |  5.0 KB  |  214 lines
  1. /* xlsym - symbol handling routines */
  2.  
  3. #ifdef AZTEC
  4. #include "stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* global variables */
  12. struct node *oblist;
  13. struct node *s_unbound;
  14.  
  15. /* external variables */
  16. extern struct node *xlstack;
  17.  
  18. /* forward declarations */
  19. FORWARD struct node *xlmakesym();
  20. FORWARD struct node *findprop();
  21.  
  22. /* xlenter - enter a symbol into the oblist */
  23. struct node *xlenter(name,type)
  24.   char *name;
  25. {
  26.     struct node *oldstk,*lsym,*nsym,newsym;
  27.     int cmp;
  28.  
  29.     /* check for nil */
  30.     if (strcmp(name,"nil") == 0)
  31.     return (NULL);
  32.  
  33.     /* check for symbol already in table */
  34.     lsym = NULL;
  35.     nsym = oblist->n_symvalue;
  36.     while (nsym) {
  37.     if ((cmp = strcmp(name,xlsymname(nsym->n_listvalue))) <= 0)
  38.         break;
  39.     lsym = nsym;
  40.     nsym = nsym->n_listnext;
  41.     }
  42.  
  43.     /* check to see if we found it */
  44.     if (nsym && cmp == 0)
  45.     return (nsym->n_listvalue);
  46.  
  47.     /* make a new symbol node and link it into the oblist */
  48.     oldstk = xlsave(&newsym,NULL);
  49.     newsym.n_ptr = newnode(LIST);
  50.     newsym.n_ptr->n_listvalue = xlmakesym(name,type);
  51.     newsym.n_ptr->n_listnext = nsym;
  52.     if (lsym)
  53.     lsym->n_listnext = newsym.n_ptr;
  54.     else
  55.     oblist->n_symvalue = newsym.n_ptr;
  56.     xlstack = oldstk;
  57.  
  58.     /* return the new symbol */
  59.     return (newsym.n_ptr->n_listvalue);
  60. }
  61.  
  62. /* xlsenter - enter a symbol with a static print name */
  63. struct node *xlsenter(name)
  64.   char *name;
  65. {
  66.     return (xlenter(name,STATIC));
  67. }
  68.  
  69. /* xlintern - intern a symbol onto the oblist */
  70. struct node *xlintern(sym)
  71.   struct node *sym;
  72. {
  73.     struct node *oldstk,*lsym,*nsym,newsym;
  74.     char *name;
  75.     int cmp;
  76.  
  77.     /* get the symbol's print name */
  78.     name = xlsymname(sym);
  79.  
  80.     /* check for nil */
  81.     if (strcmp(name,"nil") == 0)
  82.     return (NULL);
  83.  
  84.     /* check for symbol already in table */
  85.     lsym = NULL;
  86.     nsym = oblist->n_symvalue;
  87.     while (nsym) {
  88.     if ((cmp = strcmp(name,xlsymname(nsym->n_listvalue))) <= 0)
  89.         break;
  90.     lsym = nsym;
  91.     nsym = nsym->n_listnext;
  92.     }
  93.  
  94.     /* check to see if we found it */
  95.     if (nsym && cmp == 0)
  96.     return (nsym->n_listvalue);
  97.  
  98.     /* link the symbol into the oblist */
  99.     oldstk = xlsave(&newsym,NULL);
  100.     newsym.n_ptr = newnode(LIST);
  101.     newsym.n_ptr->n_listvalue = sym;
  102.     newsym.n_ptr->n_listnext = nsym;
  103.     if (lsym)
  104.     lsym->n_listnext = newsym.n_ptr;
  105.     else
  106.     oblist->n_symvalue = newsym.n_ptr;
  107.     xlstack = oldstk;
  108.  
  109.     /* return the symbol */
  110.     return (sym);
  111. }
  112.  
  113. /* xlmakesym - make a new symbol node */
  114. struct node *xlmakesym(name,type)
  115.   char *name;
  116. {
  117.     struct node *oldstk,sym,*str;
  118.  
  119.     /* create a new stack frame */
  120.     oldstk = xlsave(&sym,NULL);
  121.  
  122.     /* make a new symbol node */
  123.     sym.n_ptr = newnode(SYM);
  124.     sym.n_ptr->n_symvalue = s_unbound;
  125.     sym.n_ptr->n_symplist = newnode(LIST);
  126.     sym.n_ptr->n_symplist->n_listvalue = str = newnode(STR);
  127.     str->n_str = (type == DYNAMIC ? strsave(name) : name);
  128.     str->n_strtype = type;
  129.  
  130.     /* restore the previous stack frame */
  131.     xlstack = oldstk;
  132.  
  133.     /* return the new symbol node */
  134.     return (sym.n_ptr);
  135. }
  136.  
  137. /* xlsymname - return the print name of a symbol */
  138. char *xlsymname(sym)
  139.   struct node *sym;
  140. {
  141.     return (sym->n_symplist->n_listvalue->n_str);
  142. }
  143.  
  144. /* xlgetprop - get the value of a property */
  145. struct node *xlgetprop(sym,prp)
  146.   struct node *sym,*prp;
  147. {
  148.     struct node *p;
  149.  
  150.     if ((p = findprop(sym,prp)) == NULL)
  151.     return (NULL);
  152.     return (p->n_listnext);
  153. }
  154.  
  155. /* xlputprop - put a property value onto the property list */
  156. xlputprop(sym,val,prp)
  157.   struct node *sym,*val,*prp;
  158. {
  159.     struct node *oldstk,p,*pair;
  160.  
  161.     if ((pair = findprop(sym,prp)) == NULL) {
  162.     oldstk = xlsave(&p,NULL);
  163.     p.n_ptr = newnode(LIST);
  164.     p.n_ptr->n_listvalue = pair = newnode(LIST);
  165.     p.n_ptr->n_listnext = sym->n_symplist->n_listnext;
  166.     sym->n_symplist->n_listnext = p.n_ptr;
  167.     pair->n_listvalue = prp;
  168.     xlstack = oldstk;
  169.     }
  170.     pair->n_listnext = val;
  171. }
  172.  
  173. /* xlremprop - remove a property from a property list */
  174. xlremprop(sym,prp)
  175.   struct node *sym,*prp;
  176. {
  177.     struct node *last,*p;
  178.  
  179.     last = NULL;
  180.     for (p = sym->n_symplist->n_listnext; p; p = p->n_listnext) {
  181.     if (p->n_listvalue->n_listvalue == prp)
  182.         if (last)
  183.         last->n_listnext = p->n_listnext;
  184.         else
  185.         sym->n_symplist->n_listnext = p->n_listnext;
  186.     last = p;
  187.     }
  188. }
  189.  
  190. /* findprop - find a property pair */
  191. LOCAL struct node *findprop(sym,prp)
  192.   struct node *sym,*prp;
  193. {
  194.     struct node *p;
  195.  
  196.     for (p = sym->n_symplist->n_listnext; p; p = p->n_listnext)
  197.     if (p->n_listvalue->n_listvalue == prp)
  198.         return (p->n_listvalue);
  199.     return (NULL);
  200. }
  201.  
  202. /* xlsinit - symbol initialization routine */
  203. xlsinit()
  204. {
  205.     /* initialize the oblist */
  206.     oblist = xlmakesym("*oblist*",STATIC);
  207.     oblist->n_symvalue = newnode(LIST);
  208.     oblist->n_symvalue->n_listvalue = oblist;
  209.  
  210.     /* enter the unbound symbol indicator */
  211.     s_unbound = xlsenter("*unbound*");
  212.     s_unbound->n_symvalue = s_unbound;
  213. }
  214.