intern.c
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* EusLisp: intern.c
00003 /*    intern a symbol in a package
00004 /*    Copyright (c) 1989, Toshihiro MATSUI, Electrotechnical Laboratory
00005 /*
00006 /****************************************************************/
00007 static char *rcsid="@(#)$Id$";
00008 
00009 #include "eus.h"
00010 
00011 int export_all;
00012 
00013 int rehash(str)
00014 register pointer str;   /*string object*/
00015 { register int i,l,hash;
00016   register byte *id;
00017   id=str->c.str.chars;
00018   l=vecsize(str);
00019   hash=l;
00020   for (i=0; i<l; i++) hash+=(hash<<2)+id[i];
00021   return(hash & 0x1fffffff);}
00022 
00023 pointer findsymbol(id,l,symvec,hashval)
00024 byte *id;
00025 int l,*hashval;
00026 register pointer symvec;
00027 { register pointer sym,pnam;
00028   register int i,size,hash=l,flag=0;
00029   for (i=0; i<l; i++) hash+=(hash<<2)+id[i];
00030   hash&=0x1fffffff;
00031   size=vecsize(symvec);
00032   if (size==0) return(NULL);
00033   hash=hash % size;
00034   do {
00035     sym = symvec->c.vec.v[hash];
00036     if (issymbol(sym)) {
00037       pnam=sym->c.sym.pname;
00038       if (strlength(pnam)==l &&
00039           !memcmp((char *)pnam->c.str.chars, (char *)id, l)) {
00040         *hashval=hash; return(sym);}}
00041     if (sym==makeint(0)) {
00042       if (flag==0) *hashval=hash;
00043       return(NULL);}
00044     if (sym==makeint(1) && flag==0) { flag=1; *hashval=hash;} 
00045     if (++hash>=size) hash=0;}
00046     while (1);}
00047 
00048 static pointer extendsymvec(symvec)
00049 pointer symvec;
00050 { register pointer newsymvec,sym;
00051   bpointer bp;
00052   register int i,newsize,size,hash;
00053     size=vecsize(symvec);
00054     bp=bpointerof(symvec);
00055 #ifdef RGC
00056     newsize=buddysize[(bp->h.bix & TAGMASK)+1]-2;
00057 #else
00058     newsize=buddysize[bp->h.bix+1]-2;
00059 #endif
00060     newsymvec=makevector(C_VECTOR,newsize);
00061     for (i=0; i<newsize; i++) newsymvec->c.vec.v[i]=makeint(0); /*empty mark*/
00062     for (i=0; i<size; i++) {    /*rehash all symbols*/
00063       sym=symvec->c.vec.v[i];
00064       if (issymbol(sym)) {
00065         hash=rehash(sym->c.sym.pname) % newsize;
00066         while (newsymvec->c.vec.v[hash]!=makeint(0)) {  /*find an empty slot*/
00067           if (++hash>=newsize) hash=0;}
00068         pointer_update(newsymvec->c.vec.v[hash],sym);}}
00069 #ifdef SAFETY
00070     take_care(newsymvec);
00071 #endif
00072     return(newsymvec);}
00073 
00074 pointer export(sym,pkg)
00075 pointer sym,pkg;
00076 { register pointer symvec=pkg->c.pkg.symvector; /*external symbol table*/
00077   register int size, newsymcount;
00078   int  hash;
00079   pointer usedby,usedbylist=pkg->c.pkg.used_by;
00080   pointer pnam,s;
00081 
00082   pnam=sym->c.sym.pname;
00083   usedby = (T);
00084   /*check symbol conflict in each of used-by packages*/
00085   while (usedby && iscons(usedbylist)) {
00086     usedby=ccar(usedbylist);
00087     usedbylist=ccdr(usedbylist);
00088     s=findsymbol(pnam->c.str.chars, strlength(pnam),
00089                  usedby->c.pkg.intsymvector, &hash);
00090     if (s && s!=sym)  error(E_SYMBOLCONFLICT,sym);}
00091   size=vecsize(symvec);
00092   hash=rehash(pnam) % size;
00093   while (1) {
00094     if (symvec->c.vec.v[hash]==sym) return(sym);
00095     if (isint(symvec->c.vec.v[hash])) {
00096       pointer_update(symvec->c.vec.v[hash],sym);
00097       newsymcount=intval(pkg->c.pkg.symcount)+1;
00098       pkg->c.pkg.symcount=makeint(newsymcount);
00099       if (newsymcount > (size / 2)) 
00100           pointer_update(pkg->c.pkg.symvector, extendsymvec(symvec));
00101       return(sym);}
00102     else if (++hash>=size) hash=0;}
00103   }
00104 
00105 pointer intern(ctx,id,l,pkg)
00106 register context *ctx;
00107 char *id;       /*pointer to a string*/
00108 int l;          /*l=strlen(id)*/
00109 pointer pkg;    /*destination package*/
00110 { register pointer sym,symvec,newsym,uselist,use;
00111   register int i,size;
00112   int hash,newhash;
00113 
00114   if ((sym=findsymbol((byte *)id,l,pkg->c.pkg.intsymvector,&hash))) return(sym);
00115   uselist=pkg->c.pkg.use;
00116   while (islist(uselist)) { /*search in external symbols in inherited packages*/
00117     use=ccar(uselist);
00118     uselist=ccdr(uselist);
00119     if ((sym=findsymbol((byte *)id,l,use->c.pkg.symvector,&newhash))) return(sym);}
00120   /*create the symbol and insert it in the package*/
00121   symvec=pkg->c.pkg.intsymvector;
00122   size=vecsize(symvec);
00123   newsym=makesymbol(ctx,id,l,pkg);
00124   /*put it in the package*/
00125   while (issymbol(symvec->c.vec.v[hash]))  if (++hash>=size) hash=0;
00126   pointer_update(symvec->c.vec.v[hash],newsym);
00127   if (pkg==keywordpkg) {
00128     newsym->c.sym.vtype=V_CONSTANT;
00129     pointer_update(newsym->c.sym.speval,newsym);
00130     export(newsym,pkg);}
00131   l=intval(pkg->c.pkg.intsymcount)+1;
00132   pkg->c.pkg.intsymcount=makeint(l);
00133   if (l>(size/2)) { /*extend hash table*/
00134     vpush(newsym);
00135     pointer_update(pkg->c.pkg.intsymvector,extendsymvec(symvec));
00136     vpop();}
00137   /* export all the symbols to avoid incompatibility with old EusLisp*/
00138   if (export_all) export(newsym, pkg);
00139 #ifdef SAFETY
00140   take_care(newsym);
00141 #endif
00142   return(newsym); }
00143 
00144 


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Sep 3 2015 10:36:19