home *** CD-ROM | disk | FTP | other *** search
/ Amiga ACS 1998 #4 / amigaacscoverdisc1998-041998.iso / utilities / shareware / dev / ucb_logoppc / source / intern.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-06-25  |  3.9 KB  |  139 lines
  1. /*
  2.  *      intern.c        logo data interning module              dvb
  3.  *
  4.  *    Copyright (C) 1993 by the Regents of the University of California
  5.  *
  6.  *      This program is free software; you can redistribute it and/or modify
  7.  *      it under the terms of the GNU General Public License as published by
  8.  *      the Free Software Foundation; either version 2 of the License, or
  9.  *      (at your option) any later version.
  10.  *  
  11.  *      This program is distributed in the hope that it will be useful,
  12.  *      but 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 this program; if not, write to the Free Software
  18.  *      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  *
  20.  */
  21.  
  22. #include "logo.h"
  23. #include "globals.h"
  24.  
  25. NODE *hash_table[HASH_LEN] = {NIL};
  26.  
  27. void map_oblist(void (*fcn)()) {
  28.     int i;
  29.     NODE *nd;
  30.  
  31.     for (i = 0; i < HASH_LEN; i++)
  32.     for (nd = hash_table[i]; nd != NIL; nd = cdr(nd))
  33.         (*fcn) (car(nd));
  34. }
  35.  
  36. FIXNUM hash(char *s, int len) {
  37.     /* Map S to an integer in the range 0 .. HASH_LEN-1. */
  38.     /* Method attributed to Peter Weinberger, adapted from Aho, Sethi, */
  39.     /* and Ullman's book, Compilers: Principles, Techniques, and */
  40.     /* Tools; figure 7.35. */
  41.  
  42.     unsigned FIXNUM h = 0, g;
  43.  
  44.     while (--len >= 0) {
  45.     h = (h << 4) + (FIXNUM)(*s++);
  46.     g = h & (0xf << (WORDSIZE-4));
  47.     if (g != 0) {
  48.         h ^= g ^ (g >> (WORDSIZE-8));
  49.     }
  50.     }
  51.     return h % HASH_LEN;
  52. }
  53.  
  54. NODE *make_case(NODE *casestrnd, NODE *obj) {
  55.     NODE *new_caseobj, *clistptr;
  56.  
  57.     clistptr = caselistptr__object(obj);
  58.     new_caseobj = make_caseobj(casestrnd, obj);
  59.     setcdr(clistptr, cons(new_caseobj, cdr(clistptr)));
  60.     return(new_caseobj);
  61. }
  62.  
  63. NODE *make_object(NODE *canonical, NODE *proc, NODE *val,
  64.           NODE *plist, NODE *casestrnd) {
  65.     NODE *temp;
  66.  
  67.     temp = cons_list(0, canonical, proc, val, plist,
  68.              make_intnode((FIXNUM)0), END_OF_LIST);
  69.     make_case(casestrnd, temp);
  70.     return(temp);
  71. }
  72.  
  73. NODE *make_instance(NODE *casend, NODE *lownd) {
  74.     NODE *obj;
  75.     FIXNUM hashind;
  76.  
  77.     /* Called only if arg isn't already in hash table */
  78.  
  79.     obj = make_object(lownd, UNDEFINED, UNBOUND, NIL, casend);
  80.     hashind = hash(getstrptr(lownd), getstrlen(lownd));
  81.     push(obj,(hash_table[hashind]));
  82.     return car(caselist__object(obj));
  83. }
  84.  
  85. NODE *find_instance(NODE *lownd) {
  86.     NODE *hash_entry, *thisobj = NIL;
  87.     int cmpresult;
  88.  
  89.     hash_entry = hash_table[hash(getstrptr(lownd), getstrlen(lownd))];
  90.  
  91.     while (hash_entry != NIL) {
  92.     thisobj = car(hash_entry);
  93.     cmpresult = compare_node(lownd, canonical__object(thisobj), FALSE);
  94.     if (cmpresult == 0)
  95.         break;
  96.     else
  97.         hash_entry = cdr(hash_entry);
  98.     }
  99.     if (hash_entry == NIL) return(NIL);
  100.     else return(thisobj);
  101. }
  102.  
  103. int case_compare(NODE *nd1, NODE *nd2) {
  104.     if (backslashed(nd1) && backslashed(nd2)) {
  105.     if (getstrlen(nd1) != getstrlen(nd2)) return(1);
  106.     return(strncmp(getstrptr(nd1), getstrptr(nd2),
  107.                getstrlen(nd1)));
  108.     }
  109.     if (backslashed(nd1) || backslashed(nd2))
  110.     return(1);
  111.     return(compare_node(nd1, nd2, FALSE));
  112. }
  113.  
  114. NODE *find_case(NODE *strnd, NODE *obj) {
  115.     NODE *clist;
  116.  
  117.     clist = caselist__object(obj);
  118.     while (clist != NIL &&
  119.         case_compare(strnd, strnode__caseobj(car(clist))))
  120.     clist = cdr(clist);
  121.     if (clist == NIL) return(NIL);
  122.     else return(car(clist));
  123. }
  124.  
  125. NODE *intern(NODE *nd) {
  126.     NODE *obj, *casedes, *lownd;
  127.  
  128.     if (nodetype(nd) == CASEOBJ) return(nd);
  129.     nd = cnv_node_to_strnode(nd);
  130.     lownd = make_strnode(getstrptr(nd), (struct string_block *)NULL,
  131.              getstrlen(nd), STRING, noparitylow_strnzcpy);
  132.     if ((obj = find_instance(lownd)) != NIL) {
  133.     if ((casedes = find_case(nd, obj)) == NIL)
  134.         casedes = make_case(nd, obj);
  135.     } else
  136.     casedes = make_instance(nd, lownd);
  137.     return(casedes);
  138. }
  139.