home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / may94 / util / edit / jade.lha / Jade / src / symbols.c < prev    next >
C/C++ Source or Header  |  1994-04-19  |  27KB  |  1,050 lines
  1. /* symbols.c -- Lisp symbol handling
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. This file is part of Jade.
  5.  
  6. Jade is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. Jade is distributed in the hope that it will be useful, but
  12. WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with Jade; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "jade.h"
  21. #include "jade_protos.h"
  22. #include "regexp/regexp.h"
  23.  
  24. #include <string.h>
  25. #include <ctype.h>
  26. #include <stdlib.h>
  27.  
  28. _PR void symbol_sweep(void);
  29. _PR int symbol_cmp(VALUE, VALUE);
  30. _PR void symbol_princ(VALUE, VALUE);
  31. _PR void symbol_print(VALUE, VALUE);
  32. _PR VALUE addsubr(VALUE);
  33. _PR VALUE addconstnum(VALUE, long);
  34. _PR void internstatic(VALUE *, VALUE);
  35. _PR VALUE bindsymbol(VALUE, VALUE, VALUE);
  36. _PR void unbindsymbols(VALUE);
  37. _PR int symbols_init(void);
  38. _PR void symbols_kill(void);
  39.  
  40. /*
  41.  * Main storage of symbols
  42.  */
  43. _PR VALUE ObArray;
  44. VALUE ObArray;
  45.  
  46. _PR VALUE sym_nil, sym_t;
  47. VALUE sym_nil, sym_t;
  48.  
  49. _PR VALUE sym_variable_documentation;
  50. VALUE sym_variable_documentation;
  51.  
  52. static SymbolBlk *SymbolBlkChain;
  53. static Symbol *SymbolFreeList;
  54. _PR int AllocatedSymbols, UsedSymbols;
  55. int AllocatedSymbols, UsedSymbols;
  56.  
  57. _PR VALUE cmd_make_symbol(VALUE);
  58. DEFUN("make-symbol", cmd_make_symbol, subr_make_symbol, (VALUE name), V_Subr1, DOC_make_symbol) /*
  59. ::doc:make_symbol::
  60. (make-symbol NAME)
  61. Returns a new, uninterned, symbol with print-name NAME. It's value and
  62. function definition are both void and it has a nil property-list.
  63. ::end:: */
  64. {
  65.     VALUE sym;
  66.     DECLARE1(name, STRINGP);
  67.     if(!SymbolFreeList)
  68.     {
  69.     SymbolBlk *sb = mycalloc(sizeof(SymbolBlk));
  70.     if(sb)
  71.     {
  72.         int i;
  73.         AllocatedSymbols += SYMBOLBLK_SIZE;
  74.         sb->sb_Next = SymbolBlkChain;
  75.         SymbolBlkChain = sb;
  76.         for(i = 0; i < (SYMBOLBLK_SIZE - 1); i++)
  77.         sb->sb_Symbols[i].sym_Next = &sb->sb_Symbols[i + 1];
  78.         sb->sb_Symbols[i].sym_Next = SymbolFreeList;
  79.         SymbolFreeList = sb->sb_Symbols;
  80.     }
  81.     }
  82.     if((sym = SymbolFreeList))
  83.     {
  84.     SymbolFreeList = VSYM(sym)->sym_Next;
  85.     VSYM(sym)->sym_Next = NULL;
  86.     VSYM(sym)->sym_Type = V_Symbol;
  87.     VSYM(sym)->sym_Flags = 0;
  88.     VSYM(sym)->sym_Name = name;
  89.     VSYM(sym)->sym_Value = NULL;
  90.     VSYM(sym)->sym_Function = NULL;
  91.     VSYM(sym)->sym_PropList = sym_nil;
  92.     UsedSymbols++;
  93.     DataAfterGC += sizeof(Symbol);
  94.     }
  95.     return(sym);
  96. }
  97. void
  98. symbol_sweep(void)
  99. {
  100.     SymbolBlk *sb = SymbolBlkChain;
  101.     SymbolFreeList = NULL;
  102.     UsedSymbols = 0;
  103.     while(sb)
  104.     {
  105.     int i;
  106.     SymbolBlk *nxt = sb->sb_Next;
  107.     for(i = 0; i < SYMBOLBLK_SIZE; i++)
  108.     {
  109.         if(!GC_MARKEDP(&sb->sb_Symbols[i]))
  110.         {
  111.         sb->sb_Symbols[i].sym_Next = SymbolFreeList;
  112.         SymbolFreeList = &sb->sb_Symbols[i];
  113.         }
  114.         else
  115.         {
  116.         GC_CLR(&sb->sb_Symbols[i]);
  117.         UsedSymbols++;
  118.         }
  119.     }
  120.     sb = nxt;
  121.     }
  122. }
  123. int
  124. symbol_cmp(VALUE v1, VALUE v2)
  125. {
  126.     if(VTYPE(v1) == VTYPE(v2))
  127.     return(!(VSYM(v1) == VSYM(v2)));
  128.     return(1);
  129. }
  130. void
  131. symbol_princ(VALUE strm, VALUE obj)
  132. {
  133.     streamputs(strm, VSTR(VSYM(obj)->sym_Name), TRUE);
  134. }
  135. void
  136. symbol_print(VALUE strm, VALUE obj)
  137. {
  138.     u_char *s = VSTR(VSYM(obj)->sym_Name);
  139.     u_char c;
  140.     while((c = *s++))
  141.     {
  142.     switch(c)
  143.     {
  144.     case ' ':
  145.     case '\t':
  146.     case '\n':
  147.     case '\f':
  148.     case '(':
  149.     case ')':
  150.     case '[':
  151.     case ']':
  152.     case '\'':
  153.     case '"':
  154.     case ';':
  155.     case '\\':
  156.     case '|':
  157.         streamputc(strm, (int)'\\');
  158.         break;
  159.     default:
  160.         if(iscntrl(c))
  161.         streamputc(strm, (int)'\\');
  162.         break;
  163.     }
  164.     streamputc(strm, (int)c);
  165.     }
  166. }
  167.  
  168. VALUE
  169. addsubr(VALUE subr)
  170. {
  171.     VALUE sym = cmd_intern(VSUBR(subr)->subr_Name, ObArray);
  172.     if(sym)
  173.     {
  174.     if(VSUBR(subr)->subr_Type == V_Var)
  175.     {
  176.         VSYM(sym)->sym_Value = subr;
  177.         VSYM(sym)->sym_PropList = cmd_cons(sym_variable_documentation, cmd_cons(newnumber(VSUBR(subr)->subr_DocIndex), VSYM(sym)->sym_PropList));
  178.     }
  179.     else
  180.         VSYM(sym)->sym_Function = subr;
  181.     }
  182.     return(sym);
  183. }
  184. VALUE
  185. addconstnum(VALUE name, long num)
  186. {
  187.     VALUE sym = cmd_intern(name, ObArray);
  188.     if(sym)
  189.     {
  190.     VSYM(sym)->sym_Value = newnumber(num);
  191.     VSYM(sym)->sym_Flags |= SF_CONSTANT;
  192.     }
  193.     return(sym);
  194. }
  195. void
  196. internstatic(VALUE *symp, VALUE name)
  197. {
  198.     if((*symp = cmd_intern(name, sym_nil)))
  199.     markstatic(symp);
  200.     else
  201.     abort();
  202. }
  203.  
  204. static INLINE u_long
  205. hash(u_char *str)
  206. {
  207.     u_long value = 0;
  208.     while(*str)
  209.     value = (value * 33) + *str++;
  210.     return(value);
  211. }
  212.  
  213. _PR VALUE cmd_make_obarray(VALUE);
  214. DEFUN("make-obarray", cmd_make_obarray, subr_make_obarray, (VALUE size), V_Subr1, DOC_make_obarray) /*
  215. ::doc:make_obarray::
  216. (make-obarray SIZE)
  217. Creates a new structure for storing symbols in. This is basically a vector
  218. with a few slight differences (all pointers initialised to NULL).
  219. ::end:: */
  220. {
  221.     DECLARE1(size, NUMBERP);
  222.     return(newvector(VNUM(size)));
  223. }
  224.  
  225. _PR VALUE cmd_find_symbol(VALUE, VALUE);
  226. DEFUN("find-symbol", cmd_find_symbol, subr_find_symbol, (VALUE name, VALUE ob), V_Subr2, DOC_find_symbol) /*
  227. ::doc:find_symbol::
  228. (find-symbol NAME [OBARRAY])
  229. Returns the symbol with print-name NAME, found by searching OBARRAY (or
  230. the default `obarray' if nil), or nil if no such symbol exists.
  231. ::end:: */
  232. {
  233.     int vsize;
  234.     DECLARE1(name, STRINGP);
  235.     if(!VECTORP(ob))
  236.     ob = ObArray;
  237.     if((vsize = VVECT(ob)->vc_Size) == 0)
  238.     return(sym_nil);
  239.     ob = VVECT(ob)->vc_Array[hash(VSTR(name)) % vsize];
  240.     while(ob && SYMBOLP(ob))
  241.     {
  242.     if(!strcmp(VSTR(name), VSTR(VSYM(ob)->sym_Name)))
  243.         return(ob);
  244.     ob = VSYM(ob)->sym_Next;
  245.     }
  246.     return(sym_nil);
  247. }
  248.  
  249. _PR VALUE cmd_intern_symbol(VALUE, VALUE);
  250. DEFUN("intern-symbol", cmd_intern_symbol, subr_intern_symbol, (VALUE sym, VALUE ob), V_Subr2, DOC_intern_symbol) /*
  251. ::doc:intern_symbol::
  252. (intern-symbol SYMBOL [OBARRAY])
  253. Stores SYMBOL in OBARRAY (or the default). If SYMBOL has already been interned
  254. somewhere an error is signalled.
  255. ::end:: */
  256. {
  257.     int vsize, hashid;
  258.     DECLARE1(sym, SYMBOLP);
  259.     if(VSYM(sym)->sym_Flags & SF_INTERNED)
  260.     {
  261.     cmd_signal(sym_error, list_2(MKSTR("Symbol is already interned"), sym));
  262.     return(NULL);
  263.     }
  264.     if(!VECTORP(ob))
  265.     ob = ObArray;
  266.     if((vsize = VVECT(ob)->vc_Size) == 0)
  267.     return(NULL);
  268.     hashid = hash(VSTR(VSYM(sym)->sym_Name)) % vsize;
  269.     VSYM(sym)->sym_Next = VVECT(ob)->vc_Array[hashid];
  270.     VVECT(ob)->vc_Array[hashid] = sym;
  271.     VSYM(sym)->sym_Flags |= SF_INTERNED;
  272.     return(sym);
  273. }
  274.  
  275. _PR VALUE cmd_intern(VALUE, VALUE);
  276. DEFUN("intern", cmd_intern, subr_intern, (VALUE name, VALUE ob), V_Subr2, DOC_intern) /*
  277. ::doc:intern::
  278. (intern NAME [OBARRAY])
  279. If a symbol with print-name exists in OBARRAY (or the default) return it.
  280. Else use `(make-symbol NAME)' to create a new symbol, intern that into the
  281. OBARRAY, then return it.
  282. ::end:: */
  283. {
  284.     VALUE sym;
  285.     DECLARE1(name, STRINGP);
  286.     if(!(sym = cmd_find_symbol(name, ob))
  287.        || (NILP(sym) && strcmp(VSTR(name), "nil")))
  288.     {
  289.     sym = cmd_make_symbol(name);
  290.     if(sym)
  291.         return(cmd_intern_symbol(sym, ob));
  292.     }
  293.     return(sym);
  294. }
  295.  
  296. _PR VALUE cmd_unintern(VALUE, VALUE);
  297. DEFUN("unintern", cmd_unintern, subr_unintern, (VALUE sym, VALUE ob), V_Subr2, DOC_unintern) /*
  298. ::doc:unintern::
  299. (unintern SYMBOL [OBARRAY])
  300. Removes SYMBOL from OBARRAY (or the default). Use this with caution.
  301. ::end:: */
  302. {
  303.     Symbol *list;
  304.     int vsize, hashid;
  305.     DECLARE1(sym, SYMBOLP);
  306.     if(!VECTORP(ob))
  307.     ob = ObArray;
  308.     if((vsize = VVECT(ob)->vc_Size) == 0)
  309.     return(NULL);
  310.     hashid = hash(VSTR(VSYM(sym)->sym_Name)) % vsize;
  311.     list = VVECT(ob)->vc_Array[hashid];
  312.     VVECT(ob)->vc_Array[hashid] = NULL;
  313.     while(list)
  314.     {
  315.     Symbol *nxt = list->sym_Next;
  316.     if(list != sym)
  317.     {
  318.         list->sym_Next = VVECT(ob)->vc_Array[hashid];
  319.         VVECT(ob)->vc_Array[hashid] = list;
  320.     }
  321.     list = nxt;
  322.     }
  323.     /* This is probably unnecessary. */
  324.     VSYM(sym)->sym_Next = NULL;
  325.     VSYM(sym)->sym_Flags &= ~SF_INTERNED;
  326.     return(sym);
  327. }
  328.  
  329. /*
  330.  * This give a symbol a new value, saving the old one onto the front