home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1991 / 08 / xscheme / xssym.c < prev   
Text File  |  1991-05-13  |  2KB  |  92 lines
  1. /* xssym.c - symbol handling routines */
  2. /*    Copyright (c) 1988, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xscheme.h"
  7.  
  8. /* external variables */
  9. extern LVAL obarray;
  10.  
  11. /* forward declarations */
  12. #ifdef __STDC__
  13. static LVAL findprop(LVAL sym,LVAL prp);
  14. #else
  15. LVAL findprop();
  16. #endif
  17.  
  18. /* xlsubr - define a builtin function */
  19. void xlsubr(sname,type,fcn,offset)
  20.   char *sname; int type; LVAL (*fcn)(); int offset;
  21. {
  22.     LVAL sym;
  23.     sym = xlenter(sname);
  24.     setvalue(sym,cvsubr(type,fcn,offset));
  25. }
  26.  
  27. /* xlenter - enter a symbol into the obarray */
  28. LVAL xlenter(name)
  29.   char *name;
  30. {
  31.     LVAL array,sym;
  32.     int i;
  33.  
  34.     /* get the current obarray and the hash index for this symbol */
  35.     array = getvalue(obarray);
  36.     i = hash(name,HSIZE);
  37.  
  38.     /* check if symbol is already in table */
  39.     for (sym = getelement(array,i); sym; sym = cdr(sym))
  40.     if (strcmp(name,getstring(getpname(car(sym)))) == 0)
  41.         return (car(sym));
  42.  
  43.     /* make a new symbol node and link it into the list */
  44.     sym = cons(cvsymbol(name),getelement(array,i));
  45.     setelement(array,i,sym);
  46.     sym = car(sym);
  47.  
  48.     /* return the new symbol */
  49.     return (sym);
  50. }
  51.  
  52. /* xlgetprop - get the value of a property */
  53. LVAL xlgetprop(sym,prp)
  54.   LVAL sym,prp;
  55. {
  56.     LVAL p;
  57.     return ((p = findprop(sym,prp)) == NIL ? NIL : car(p));
  58. }
  59.  
  60. /* xlputprop - put a property value onto the property list */
  61. void xlputprop(sym,val,prp)
  62.   LVAL sym,val,prp;
  63. {
  64.     LVAL pair;
  65.     if ((pair = findprop(sym,prp)) != NIL)
  66.     rplaca(pair,val);
  67.     else
  68.     setplist(sym,cons(prp,cons(val,getplist(sym))));
  69. }
  70.  
  71. /* findprop - find a property pair */
  72. static LVAL findprop(sym,prp)
  73.   LVAL sym,prp;
  74. {
  75.     LVAL p;
  76.     for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
  77.     if (car(p) == prp)
  78.         return (cdr(p));
  79.     return (NIL);
  80. }
  81.  
  82. /* hash - hash a symbol name string */
  83. int hash(str,len)
  84.   char *str; int len;
  85. {
  86.     int i;
  87.     for (i = 0; *str; )
  88.     i = (i << 2) ^ *str++;
  89.     i %= len;
  90.     return (i < 0 ? -i : i);
  91. }
  92.