home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / src / dictnry.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-17  |  19.0 KB  |  879 lines
  1. /*
  2.  * This file is part of the portable Forth environment written in ANSI C.
  3.  * Copyright (C) 1995  Dirk Uwe Zoller
  4.  *
  5.  * This library is free software; you can redistribute it and/or
  6.  * modify it under the terms of the GNU Library General Public
  7.  * License as published by the Free Software Foundation; either
  8.  * version 2 of the License, or (at your option) any later version.
  9.  *
  10.  * This library is distributed in the hope that it will be useful,
  11.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  * See the GNU Library General Public License for more details.
  14.  *
  15.  * You should have received a copy of the GNU Library General Public
  16.  * License along with this library; if not, write to the Free
  17.  * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  *
  19.  * This file is version 0.9.13 of 17-July-95
  20.  * Check for the latest version of this package via anonymous ftp at
  21.  *    roxi.rz.fht-mannheim.de:/pub/languages/forth/pfe-VERSION.tar.gz
  22.  * or    sunsite.unc.edu:/pub/languages/forth/pfe-VERSION.tar.gz
  23.  * or    ftp.cygnus.com:/pub/forth/pfe-VERSION.tar.gz
  24.  *
  25.  * Please direct any comments via internet to
  26.  *    duz@roxi.rz.fht-mannheim.de.
  27.  * Thank You.
  28.  */
  29. /*
  30.  * dictionary.c ---   Implements dictionary and words lists.
  31.  * (duz 06Feb94)
  32.  */
  33.  
  34. #include "forth.h"
  35. #include "support.h"
  36. #include "compiler.h"
  37. #include "term.h"
  38. #include "lined.h"
  39.  
  40. #include <string.h>
  41. #include <ctype.h>
  42.  
  43. #include "missing.h"
  44.  
  45. /*
  46.  * A vocabulary is organized as a mixture between hash-table and
  47.  * linked list. (This is a practice you can observe in several
  48.  * systems.) It works like this: Given a name, first a hash-code is
  49.  * generated. This hash-code selects one of several linked lists
  50.  * called threads. The hooks to these threads are stored in a table.
  51.  *
  52.  * The body of a WORDLIST is essentially such a table of pointers to
  53.  * threads, while in FIG-Forth it was just a pointer to the one and
  54.  * only linked list a VOCABULARY consists of in FIG-Forth.
  55.  */
  56.  
  57. int
  58. wl_hash (const char *s, int l)
  59. /* s string, l length of string, returns hash-code for that name */
  60. {
  61.   int n = *s++ - '@';
  62.  
  63.   while (--l > 0)
  64.     n = n * 37 + *s++ - '@';    /* a maybe-stupid hash function :-) */
  65.   return n & (THREADS - 1);    /* i.e. modulo threads */
  66. }
  67.  
  68. /*
  69.  * If we want to traverse a WORDLIST in it's entirety, we must follow
  70.  * all threads simultaneously. The following definition eases this by
  71.  * locating the thread with the hook pointing to the highest memory
  72.  * location, assuming that this thread contains the latest definition
  73.  * entered in the given WORDLIST. For usage refer to the definition of
  74.  * WORDS.
  75.  *
  76.  * When following a wordlist using topmost, a copy of the word list
  77.  * must be made. Everytime the topmost item was processed it must be
  78.  * replaced by its successor in the linked list.
  79.  */
  80.  
  81. char **
  82. topmost (Wordl *w)
  83. /* find the thread with the latest word in the given word list */
  84. {
  85.   int n = THREADS;
  86.   char **p, **s = w->thread;
  87.  
  88.   for (p = s++; --n; s++)
  89.     if (*s > *p)
  90.       p = s;
  91.   return p;
  92. }
  93.  
  94. char *                /* return the NFA of the latest */
  95. latest (void)            /* definition in the CURRENT WORDLIST */
  96. {
  97.   return *topmost (CURRENT);
  98. }
  99.  
  100. /* word list and forget */
  101.  
  102. Wordl *
  103. word_list (void)
  104. /* create a word list in the dictionary */
  105. {
  106.   Wordl *w = (Wordl *) DP;    /* allocate word list in HERE */
  107.   INC (DP, Wordl);
  108.  
  109.   ZERO (w->thread);        /* initialize all threads to empty */
  110.   w->prev = VOC_LINK;        /* chain word list in VOC-LINK */
  111.   VOC_LINK = w;
  112.   return w;
  113. }
  114.  
  115. void
  116. forget (char *above)
  117. /* remove words from dictionary, free dictionary space */
  118. {
  119.   Wordl *wl;
  120.  
  121.   if ((Byte *) above < FENCE)
  122.     tHrow (THROW_INVALID_FORGET);
  123.   /* unchain words in all threads of all word lists: */
  124.   for (wl = VOC_LINK; wl; wl = wl->prev)
  125.     {
  126.       char **p = wl->thread;
  127.       int i;
  128.  
  129.       for (i = THREADS; --i >= 0; p++)
  130.     /* unchain words in thread: */
  131.     while (*p >= (char *) above)
  132.       *p = *name_to_link (*p);
  133.     }
  134.   /* unchain word lists: */
  135.   while (VOC_LINK >= (Wordl *) above)
  136.     VOC_LINK = VOC_LINK->prev;
  137.   /* free dictionary space: */
  138.   DP = (Byte *) above;
  139.   LAST = NULL;
  140.   if (CURRENT >= (Wordl *) above)
  141.     tHrow (THROW_CURRENT_DELETED);
  142. }
  143.  
  144. /* search a header */
  145.  
  146. static char *
  147. search_thread (const char *nm, int l, char *t)
  148. {
  149.   char name[32];
  150.  
  151.   if (l > 31)
  152.     return NULL;
  153.   memcpy (name, nm, l);
  154.   if (LOWER_CASE)
  155.     upper (name, l);
  156.   while (t)
  157.     {
  158.       if ((*t & 0x3F) == l && strncmp (name, t + 1, l) == 0)
  159.     break;
  160.       t = *name_to_link (t);
  161.     }
  162.   return t;
  163. }
  164.  
  165. char *
  166. search_wordlist (const char *nm, int l, /*const */ Wordl *w)
  167. {
  168.   return search_thread (nm, l, w->thread[wl_hash (nm, l)]);
  169. }
  170.  
  171. char *
  172. find (const char *nm, int l)
  173. /* search all word lists in the search order for name, return NFA */
  174. {
  175.   Wordl **p, **q;
  176.   char *w = NULL;
  177.   int n = wl_hash (nm, l);
  178.  
  179.   for (p = CONTEXT; !w && p <= &ONLY; p++)
  180.     {
  181.       if (*p == NULL)
  182.     continue;
  183.       for (q = CONTEXT; *q != *p; q++);
  184.       if (q != p)
  185.     continue;
  186.       w = search_thread (nm, l, (*p)->thread[n]);
  187.     }
  188.   return w;
  189. }
  190.  
  191. char *
  192. tick (Xt *xt)            /* tick next word, store Xt in xt, */
  193. {                /* return count byte of name field */
  194.   char *p;            /* (to detect immediacy) */
  195.  
  196.   p = word (' ');
  197.   p = find ((char *) p + 1, *(Byte *) p);
  198.   if (!p)
  199.     tHrow (THROW_UNDEFINED);
  200.   *xt = name_from (p);
  201.   return p;
  202. }
  203.  
  204. /* create a header */
  205.  
  206. char *
  207. alloc_string (const char *s, int len)
  208. /* writes counted string into dictionary, returns address */
  209. {
  210.   char *p = (char *) DP;
  211.  
  212.   if (len >= (1 << CHAR_BIT))
  213.     tHrow (THROW_ARG_TYPE);
  214.   *DP++ = len;            /* store count byte */
  215.   while (--len >= 0)        /* store string */
  216.     *DP++ = (Byte) *s++;
  217.   align_ ();
  218.   return p;
  219. }
  220.  
  221. char *
  222. alloc_parsed_string (char del)
  223. {
  224.   char *p;
  225.   uCell n;
  226.  
  227.   parse (del, &p, &n);
  228.   return alloc_string (p, (int) n);
  229. }
  230.  
  231. char *
  232. alloc_word (char del)
  233. {
  234.   char *p = word (del);
  235.  
  236.   DP += *p + 1;
  237.   align_ ();
  238.   return p;
  239. }
  240.  
  241. static void            /* written to cfa by make_head() */
  242. illegal_xt (void)        /* to give an error msg when calling */
  243. {                /* a word without execution semantics */
  244.   tHrow (THROW_INVALID_NAME);
  245. }
  246.  
  247. Head *
  248. make_head (const char *name, int count, char **nfa, Wordl *wid)
  249. /* make a new dictionary entry in the word list identified by wid */
  250. {
  251.   Head *h;
  252.   int hc;
  253.  
  254.   if (count == 0)
  255.     tHrow (THROW_ZERO_NAME);
  256.   if (count > 0x1F)
  257.     tHrow (THROW_NAME_TOO_LONG);
  258.   if (REDEFINED_MSG && find (name, count))
  259.     outf ("\n\"%.*s\" is redefined ", count, name);
  260.   *nfa = LAST = alloc_string (name, count);
  261.   if (LOWER_CASE)
  262.     upper (*nfa + 1, *(Byte *) *nfa);
  263.   **nfa |= 0x80;
  264.   h = (Head *) DP;
  265.   INC (DP, Head);
  266.  
  267.   hc = wl_hash (name, count);
  268.   h->link = wid->thread[hc];
  269.   wid->thread[hc] = *nfa;
  270.   h->aux = illegal_xt;
  271.   h->cfa = illegal_xt;
  272.   return h;
  273. }
  274.  
  275. void
  276. header (pCode cfa, char flags)
  277. {
  278.   char *p = word (' ');
  279.  
  280.   make_head (p + 1, *(Byte *) p, &p, CURRENT)->cfa = cfa;
  281.   *p |= flags;
  282. }
  283.  
  284. /* navigation in the header */
  285.  
  286. char **
  287. name_to_link (const char *p)
  288. {
  289.   return (char **) aligned ((Cell) p + 1 + (*p & 0x1F));
  290. }
  291.  
  292. char *
  293. link_to_name (char **l)
  294. /*
  295.  * scan backward for count byte preceeding name of definition
  296.  * returns pointer to count byte of name field or NULL
  297.  */
  298. {
  299.   char *p = (char *) l;
  300.   int n;
  301.  
  302.   /* Skip possible alignment padding: */
  303.   for (n = 0; *--p == '\0'; n++)
  304.     if (n > sizeof (Cell) - 1)
  305.       return NULL;
  306.  
  307.   /* Scan for count byte. Note: this is not reliable! */
  308.   for (n = 0; n < 32; n++, p--)
  309.     {
  310.       if (*p & 0x80 && (*p & 0x1F) == n)
  311.     return p;
  312.       if (!printable (*p))
  313.     return NULL;
  314.     }
  315.   return NULL;
  316. }
  317.  
  318. Semant *            /* I don't like this either. :-) */
  319. to_semant (Xt xt)
  320. {
  321. #define TO_SEMANT(XT,ELEMENT) \
  322.   ((Semant *)((char *)XT - OFFSET_OF (Semant, ELEMENT)))
  323.   Semant *s;
  324.  
  325.   s = TO_SEMANT (xt, exec[0]);
  326.   if (s->magic == SEMANT_MAGIC)
  327.     return s;
  328.   s = TO_SEMANT (xt, exec[1]);
  329.   if (s->magic == SEMANT_MAGIC)
  330.     return s;
  331.   return NULL;
  332. #undef TO_SEMANT
  333. }
  334.  
  335. Xt
  336. link_from (char **lnk)
  337. {
  338.   return (Xt) ((void **) lnk + 2);
  339. }
  340.  
  341. char **
  342. to_link (Xt xt)
  343. {
  344.   Semant *s = to_semant (xt);
  345.  
  346.   return s ? name_to_link (s->name)
  347.     : (char **) xt - 2;
  348. }
  349.  
  350. Xt
  351. name_from (const char *p)
  352. {
  353.   return link_from (name_to_link (p));
  354. }
  355.  
  356. char *
  357. to_name (Xt c)
  358. {
  359.   return link_to_name (to_link (c));
  360. }
  361.  
  362. Xt
  363. runtime (void)
  364. {
  365.   if (!LAST)
  366.     tHrow (THROW_ARG_TYPE);
  367.   return name_from (LAST);
  368. }
  369.  
  370. void
  371. dot_name (const char *nfa)
  372. {
  373.   int len;
  374.  
  375.   if (!nfa || !(*nfa & 0x80))
  376.     {
  377.       outs ("<\?\?\?> ");    /* avoid trigraph interpretation */
  378.       return;
  379.     }
  380.   len = *nfa++ & 0x1F;
  381.   type (nfa, len);
  382.   space_ ();
  383. }
  384.  
  385. /* words with wildcards */
  386.  
  387. void
  388. wild_words (const Wordl *wl, const char *pattern, const char *categories)
  389. /*
  390.  * Show words in word list matching pattern, and of one of the
  391.  * categories in string `categories'. NULL pointer or zero length
  392.  * string means all kinds of words.
  393.  */
  394. {
  395.   Wordl wcopy = *wl;        /* clobbered while following it */
  396.   char **t;
  397.  
  398.   cr_ ();
  399.   start_question_cr_ ();
  400.   if (categories && *categories == '\0')
  401.     categories = NULL;
  402.   for (t = topmost (&wcopy); *t; t = topmost (&wcopy))
  403.     {
  404.       char wbuf[0x20];
  405.       char *w = *t;
  406.       char **s = name_to_link (w);
  407.       int l = *w++ & 0x1F;
  408.  
  409.       store_c_string (w, l, wbuf, sizeof wbuf);
  410.       if (match (pattern, wbuf))
  411.     {
  412.       char c = category (*link_from (s));
  413.       if (!categories || strchr (categories, c))
  414.         {
  415.           if (OUT + 20 - OUT % 20 + 2 + l > cols)
  416.         {
  417.           if (question_cr ())
  418.             break;
  419.         }
  420.           else
  421.         {
  422.           if (OUT)
  423.             tab (20);
  424.         }
  425.           outf ("%c %.*s ", c, l, w);
  426.         }
  427.     }
  428.       *t = *s;
  429.     }
  430. }
  431.  
  432. /* completion of word against dictionary */
  433.  
  434. static char *
  435. search_incomplete (const char *name, int len, Wordl *w)
  436. /*
  437.  * traverses the entire given wordlist to find a matching word
  438.  * caution: clobbers *w. This is needed to be able to continue the search.
  439.  */
  440. {
  441.   char **t, *s;
  442.  
  443.   for (t = topmost (w); *t; t = topmost (w))
  444.     {
  445.       s = *t;
  446.       *t = *name_to_link (*t);
  447.       if ((*s & 0x1F) >= len && strncmp (s + 1, name, len) == 0)
  448.     return s;
  449.     }
  450.   return NULL;
  451. }
  452.  
  453. static int
  454. complete_word (const char *in, int len, char *out, int display)
  455. /*
  456.  * Try to complete string in/len from dictionary.
  457.  * Store completion in out (asciiz), return number of possible completions.
  458.  * If display is true, display alternatives.
  459.  */
  460. {
  461.   Wordl w, **p, **q;
  462.   char *s, *t;            /* no, s and m are NOT used uninitialized */
  463.   int n, m, cnt = 0;
  464.  
  465.   for (p = CONTEXT; p <= &ONLY; p++)
  466.     {
  467.       if (!*p)
  468.     continue;
  469.       for (q = CONTEXT; *q != *p; q++);
  470.       if (q != p)
  471.     continue;
  472.       for (w = **p; (t = search_incomplete (in, len, &w)) != NULL; cnt++)
  473.     {
  474.       if (display)
  475.         {
  476.           space_ ();
  477.           type_on_line (t + 1, *t & 0x1F);
  478.         }
  479.       if (cnt == 0)
  480.         {
  481.           s = t + 1;
  482.           m = *t & 0x1F;
  483.         }
  484.       else
  485.         {
  486.           ++t;
  487.           for (n = 0; n < m; n++)
  488.         if (s[n] != t[n])
  489.           break;
  490.           m = n;
  491.         }
  492.     }
  493.     }
  494.   if (cnt)
  495.     store_c_string (s, m, out, 32);
  496.   return cnt;
  497. }
  498.  
  499. int
  500. complete_dictionary (char *in, char *out, int display)
  501. {
  502.   char *lw, buf[32];
  503.   int n;
  504.  
  505.   lw = strrchr (in, ' ');
  506.   if (lw)
  507.     lw++;
  508.   else
  509.     lw = in;
  510.   memcpy (out, in, lw - in);
  511.   upper (lw, strlen (lw));
  512.   n = complete_word (lw, strlen (lw), buf, display);
  513.   strcpy (&out[lw - in], buf);
  514.   return n;
  515. }
  516.  
  517. /************************************************************************/
  518. /* initial dictionary setup                                             */
  519. /************************************************************************/
  520.  
  521. static int
  522. load_words (const Words * wl, Wordl *wid)
  523. /*
  524.  * Load a list of words from a C-language module into the dictionary.
  525.  */
  526. {
  527.   const Word *w = wl->w;
  528.   Head *h;
  529.   char *nfa;
  530.   int i;
  531.  
  532.   for (i = wl->n; --i >= 0; w++)
  533.     {
  534.       const char *name = w->name;
  535.       char type = *name++;
  536.  
  537.       h = make_head (name, strlen (name), &nfa, wid);
  538.       if (type & 010)
  539.     *nfa |= IMMEDIATE;
  540.       switch (type)
  541.     {
  542.     case _CS:
  543.       h->aux = w->ptr;
  544.       h->cfa = ((Semant *) w->ptr)->comp;
  545.       ((Semant *) w->ptr)->name = nfa;
  546.       continue;
  547.     case _CI:
  548.     case _CO:
  549.       h->cfa = (pCode) w->ptr;
  550.       continue;
  551.     case _VO:
  552.       h->cfa = vocabulary_runtime;
  553.       ((preloadList *) w->ptr)->wid = word_list ();
  554.       continue;
  555.     case _OY:
  556.       h->cfa = only_runtime;
  557.       ((preloadList *) w->ptr)->wid = word_list ();
  558.       continue;
  559.     case _SV:
  560.       h->cfa = sysvar_runtime;
  561.       break;
  562.     case _DV:
  563.       h->cfa = dictvar_runtime;
  564.       break;
  565.     case _DC:
  566.       h->cfa = dictconst_runtime;
  567.       break;
  568.     case _SC:
  569.       h->cfa = sysconst_runtime;
  570.       break;
  571.     case _OV:
  572.     case _IV:
  573.       h->cfa = create_runtime;
  574.       break;
  575.     case _OC:
  576.     case _IC:
  577.       h->cfa = constant_runtime;
  578.       break;
  579.     case _OL:
  580.     case _IL:
  581.       h->cfa = value_runtime;
  582.       break;
  583.     }
  584.       COMMA (w->ptr);
  585.     }
  586. #if defined DEBUG
  587.   if (option.debug)
  588.     outf ("preloaded %3d words of %s\n",
  589.       wl->n, wl->name);
  590. #endif
  591.   return wl->n;
  592. }
  593.  
  594. #if defined DEBUG
  595. static void
  596. word_list_statistics (Wordl *w, int *n)
  597. {
  598.   char *thread[THREADS];
  599.   int i;
  600.  
  601.   COPY (thread, w->thread);
  602.   for (i = 0; i < THREADS; i++)
  603.     for (n[i] = 0; thread[i]; n[i]++)
  604.       thread[i] = *name_to_link (thread[i]);
  605. }
  606.  
  607. #endif
  608.  
  609. void
  610. preload_dictionary (void)
  611. {
  612.   Wordl only;            /* scratch ONLY word list */
  613.   int i, j, sum;
  614.  
  615.   DP = (Byte *) &sys.dict[1];
  616.   /* Load the ONLY word list to the empty dictionary using the scratch ONLY: */
  617.   memset (&only, 0, sizeof only);
  618.   sum = load_words (preload_list[0]->ws[0], &only);
  619.   /* Copy scratch ONLY to real ONLY: */
  620.   ONLY = only_list.wid;
  621.   COPY (ONLY->thread, only.thread);
  622.   /* initialize FORTH: */
  623.   FORTH = forth_list.wid;
  624.   /* Load signals to EXTENSIONS word list: */
  625.   load_signals (extensions_list.wid);
  626.  
  627.   /* Load all other word sets into their WORDLISTs: */
  628.   for (i = 1; i < preload_lists; i++)
  629.     for (j = preload_list[i]->n; --j >= 0;)
  630.       sum += load_words (preload_list[i]->ws[j],
  631.              preload_list[i]->wid);
  632.  
  633.   FENCE = DP;
  634.   LAST = NULL;
  635.  
  636. #if defined DEBUG
  637.   /* Maybe output some statistics: */
  638.   if (option.debug)
  639.     {
  640.       int stat[THREADS];
  641.  
  642.       outf ("preloaded %3d words total.\n", sum);
  643.       printf ("Words per thread:\nFORTH: ");
  644.       word_list_statistics (FORTH, stat);
  645.       for (i = 0; i < THREADS; i++)
  646.     printf ("%3d ", stat[i]);
  647.       printf ("\nONLY:  ");
  648.       word_list_statistics (ONLY, stat);
  649.       for (i = 0; i < THREADS; i++)
  650.     printf ("%3d ", stat[i]);
  651.       printf ("\n\n");
  652.     }
  653. #endif
  654. }
  655.  
  656. /************************************************************************/
  657. /* Save and reload dictionary.                                          */
  658. /************************************************************************/
  659.  
  660. #if 1
  661. static int
  662. encode_dist (int i1, int i2, Byte *p)
  663. /*
  664.  * i2 is an index larger than i1.
  665.  * Encodes distance between i1 and i2 as follows:
  666.  *   6-bit distance:  00bbbbbb
  667.  *  14-bit distance:  01bbbbbb bbbbbbbb
  668.  *  22-bit distance:  10bbbbbb bbbbbbbb bbbbbbbb
  669.  *  30-bit distance:  11bbbbbb bbbbbbbb bbbbbbbb bbbbbbbb
  670.  * Stores the encoding in *p, returns number of bytes stored.
  671.  */
  672. {
  673.   uCell dist = i2 - i1;
  674.  
  675.   if ((dist & 0xFFFFFFC0ul) == 0)
  676.     {
  677.       *p++ = dist;
  678.       return 1;
  679.     }
  680.   if ((dist & 0xFFFFC000ul) == 0)
  681.     {
  682.       *p++ = dist >> 8 | 0x40;
  683.       *p++ = dist;
  684.       return 2;
  685.     }
  686.   if ((dist & 0xFFC00000ul) == 0)
  687.     {
  688.       *p++ = dist >> 16 | 0x80;
  689.       *p++ = dist >> 8;
  690.       *p++ = dist;
  691.       return 3;
  692.     }
  693.   *p++ = dist >> 24 | 0xC0;
  694.   *p++ = dist >> 16;
  695.   *p++ = dist >> 8;
  696.   *p++ = dist;
  697.   return 4;
  698. }
  699.  
  700. static int
  701. next_position (Byte *p, int *dist)
  702. /*
  703.  * Reads a distance from p, encoding like described above.
  704.  * Returns number of bytes read, adds distance to *dist.
  705.  */
  706. {
  707.   Byte *q = p, c = *q++;
  708.   uCell d = c & 0x3F;
  709.  
  710.   switch (c & 0xC0)
  711.     {
  712.     case 0xC0:
  713.       d <<= 8;
  714.       d |= *q++;
  715.     case 0x80:
  716.       d <<= 8;
  717.       d |= *q++;
  718.     case 0x40:
  719.       d <<= 8;
  720.       d |= *q++;
  721.     }
  722.   *dist += d;
  723.   return q - p;
  724. }
  725.  
  726. static int
  727. compare_dictionary (uCell *src, uCell *dst, uCell cells,
  728.             Byte *p, uCell *length)
  729. /*
  730.  * Extract relocation information and prepare for later relocation.
  731.  * Compares two chunks of dictionary space, that were built identically
  732.  * on different memory locations.
  733.  * Returns success and stores indices of cells to relocate in a
  734.  * list starting at p, stores length of list in length.
  735.  */
  736. {
  737.   Byte *q = p;
  738.   uCell i0 = 0, i, dist, diff;
  739.   int ok = 1;
  740.  
  741.   dist = (uCell) dst - (uCell) src;
  742.   for (i = 0; i < cells; i++)
  743.     {
  744.       diff = dst[i] - src[i];
  745.       if (diff == 0)
  746.     /*
  747.      * Cells are same, nothing to relocate:
  748.      */
  749.     continue;
  750.       if (diff == dist)
  751.     /*
  752.      * Cells differ by the distance dst-src, that means cell is
  753.      * an address pointing inside the chunk, must be relocated:
  754.      */
  755.     {
  756.       dst[i] -= (uCell) dst;
  757.       q += encode_dist (i0, i, q);
  758.       i0 = i;
  759.       continue;
  760.     }
  761.       /*
  762.        * Cells differ by some other amount. Hugh!?
  763.        */
  764.       ok = 0;
  765.     }
  766.   *length = q - p;
  767.   return ok;
  768. }
  769.  
  770. static void
  771. relocate (uCell *dst, Byte *p, int length)
  772. /*
  773.  * Given a piece of code starting at dst and relocation info
  774.  * starting at p with the given length: this relocates the code
  775.  * by adding dst to all locations in the table.
  776.  */
  777. {
  778.   Byte *q = p + length;
  779.   int i;
  780.  
  781.   i = 0;
  782.   while (p < q)
  783.     {
  784.       p += next_position (p, &i);
  785.       dst[i] += (uCell) dst;
  786.     }
  787. }
  788.  
  789. #else
  790.  
  791. #define relocate(DST,P,LEN)
  792.  
  793. #endif
  794.  
  795. struct saved_header        /* header of saved entire dictionary */
  796. {
  797.   uCell magic;            /* makes sure it's a saved dictionary */
  798.   uCell pfe_ver;        /* version of pfe system that saved it */
  799.   uCell size;            /* size of dictionary body in bytes */
  800.   uCell reloc_size;        /* size of relocation info in bytes */
  801. };
  802.  
  803. long
  804. save_dictionary (Dict *d1, Dict *d2, const char *fn)
  805. /*
  806.  * Save entire dictionary to file, return file size.
  807.  * Clobbers the dictionary d2. So don't use it afterwards.
  808.  */
  809. {
  810.   FILE *f;
  811.   struct saved_header svhd;
  812.   long len;
  813.  
  814.   svhd.magic = SAVE_MAGIC;
  815.   svhd.pfe_ver = pfe_version_code ();
  816.   svhd.size = d1->dp - (Byte *) d1;
  817.   if (!compare_dictionary
  818.       ((uCell *) d1,
  819.        (uCell *) d2,
  820.        svhd.size / sizeof (Cell),
  821.          (Byte *) d2 + svhd.size,
  822.        &svhd.reloc_size))
  823.       return 0;
  824.  
  825.   f = fopen (fn, "wb");
  826.   if (f == NULL)
  827.     tHrow (THROW_FILE_NEX);
  828.   len = fwrite (&svhd, 1, sizeof svhd, f);
  829.   len += fwrite (d2, 1, svhd.size + svhd.reloc_size, f);
  830.   fclose (f);
  831.   if (len != sizeof svhd + svhd.size + svhd.reloc_size)
  832.     tHrow (THROW_FILE_ERROR);
  833.  
  834.   return len;
  835. }
  836.  
  837. static void            /* words with different compile/runtime */
  838. fixnames (void)            /* semantics: fill in pointer back from */
  839. {                /* semantics structure to name field */
  840.   Wordl *wl;
  841.   int i;
  842.   char *nfa;
  843.   Head *hd;
  844.   Semant *s;
  845.  
  846.   for (wl = VOC_LINK; wl; wl = wl->prev)
  847.     for (i = 0; i < THREADS; i++)
  848.       for (nfa = wl->thread[i]; nfa; nfa = hd->link)
  849.     /* now nfa runs for all words in the dictionary */
  850.     {
  851.       hd = (Head *) name_to_link (nfa);
  852.       s = (Semant *) hd->aux;
  853.       if (*nfa & IMMEDIATE && s && s->magic == SEMANT_MAGIC)
  854.         ((Semant *) hd->aux)->name = nfa;
  855.     }
  856. }
  857.  
  858. int
  859. reload_dictionary (const char *fn, Dict *dict)
  860. {
  861.   FILE *f = fopen (fn, "rb");
  862.   struct saved_header svhd;
  863.   long len;
  864.  
  865.   if (f == NULL)
  866.     tHrow (THROW_FILE_NEX);
  867.   len = fread (&svhd, 1, sizeof svhd, f);
  868.   if (svhd.magic != SAVE_MAGIC ||
  869.       svhd.pfe_ver != pfe_version_code ())
  870.     return 0;
  871.   len += fread (dict, 1, svhd.size + svhd.reloc_size, f);
  872.   fclose (f);
  873.   if (len != sizeof svhd + svhd.size + svhd.reloc_size)
  874.     return 0;
  875.   relocate ((uCell *) dict, (Byte *) dict + svhd.size, svhd.reloc_size);
  876.   fixnames ();
  877.   return 1;
  878. }
  879.