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 / search.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-17  |  3.9 KB  |  185 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.  * search.c ---       The Optional Search Order Word Set
  31.  * (duz 09Jul93)
  32.  */
  33.  
  34. #include "forth.h"
  35. #include "support.h"
  36. #include "compiler.h"
  37.  
  38. #include <string.h>
  39.  
  40. #include "missing.h"
  41.  
  42. code (definitions)
  43. {
  44.   CURRENT = CONTEXT[0];
  45. }
  46.  
  47. Code (get_current)
  48. {
  49.   *--sp = (Cell) CURRENT;
  50. }
  51.  
  52. Code (get_order)
  53. {
  54.   Wordl **p;
  55.   Cell n = 0;
  56.  
  57.   for (p = &CONTEXT[ORDER_LEN]; --p >= CONTEXT;)
  58.     if (*p)
  59.       *--sp = (Cell) *p, n++;
  60.   *--sp = n;
  61. }
  62.  
  63. Code (search_wordlist)
  64. {
  65.   char *nfa;
  66.  
  67.   nfa = search_wordlist ((char *) sp[2], sp[1], (Wordl *) sp[0]);
  68.   if (nfa == NULL)
  69.     {
  70.       sp += 2;
  71.       sp[0] = 0;
  72.     }
  73.   else
  74.     {
  75.       sp += 1;
  76.       sp[0] = *nfa & IMMEDIATE ? 1 : -1;
  77.       sp[1] = (Cell) name_from (nfa);
  78.     }
  79. }
  80.  
  81. Code (set_current)
  82. {
  83.   CURRENT = (Wordl *) *sp++;
  84. }
  85.  
  86. Code (set_order)
  87. {
  88.   Cell i, n = *sp++;
  89.  
  90.   if (n == -1)            /* minimum search order */
  91.     n = 0;            /* equals cleared search order */
  92.   if ((uCell) n > ORDER_LEN)
  93.     tHrow (THROW_SEARCH_OVER);
  94.   for (i = 0; i < n; i++)
  95.     CONTEXT[i] = (Wordl *) *sp++;
  96.   for (; i < ORDER_LEN; i++)
  97.     CONTEXT[i] = NULL;
  98. }
  99.  
  100. Code (wordlist)
  101. {
  102.   *--sp = (Cell) word_list ();
  103. }
  104.  
  105. /* Search order extension words ============================================ */
  106.  
  107. code (also)
  108. {
  109.   int i;
  110.  
  111.   if (CONTEXT[ORDER_LEN - 1])
  112.     tHrow (THROW_SEARCH_OVER);
  113.   for (i = ORDER_LEN; --i > 0;)
  114.     CONTEXT[i] = CONTEXT[i - 1];
  115. }
  116.  
  117. void
  118. only_runtime (void)
  119. {
  120.   ZERO (CONTEXT);
  121.   CONTEXT[0] = CURRENT = ONLY;
  122. }
  123.  
  124. Code (order)
  125. {
  126.   int i;
  127.  
  128.   get_order_ ();
  129.   for (i = *sp++; --i >= 0;)
  130.     {
  131.       Wordl *w = (Wordl *) *sp++;
  132.  
  133.       dot_name (to_name (BODY_FROM (w)));
  134.     }
  135.   cr_ ();
  136.   dot_name (to_name (BODY_FROM (ONLY)));
  137.   dot_name (to_name (BODY_FROM (CURRENT)));
  138. }
  139.  
  140. Code (previous)
  141. {
  142.   int i;
  143.  
  144.   for (i = 0; i < ORDER_LEN - 1; i++)
  145.     CONTEXT[i] = CONTEXT[i + 1];
  146.   CONTEXT[i] = NULL;
  147.   for (i = 0; i < ORDER_LEN; i++)
  148.     if (CONTEXT[i])
  149.       return;
  150.   tHrow (THROW_SEARCH_UNDER);
  151. }
  152.  
  153. code (default_order)
  154. {
  155.   memcpy (DEFAULT_ORDER, CONTEXT, sizeof (CONTEXT));
  156. }
  157.  
  158. code (reset_order)
  159. {
  160.   memcpy (CONTEXT, DEFAULT_ORDER, sizeof (CONTEXT));
  161. }
  162.  
  163. /* *INDENT-OFF* */
  164. LISTWORDS (search) =
  165. {
  166.   CO ("DEFINITIONS",    definitions),
  167.   DC ("FORTH-WORDLIST",    forth),
  168.   CO ("GET-CURRENT",    get_current),
  169.   CO ("GET-ORDER",    get_order),
  170.   CO ("SEARCH-WORDLIST",search_wordlist),
  171.   CO ("SET-CURRENT",    set_current),
  172.   CO ("SET-ORDER",    set_order),
  173.   CO ("WORDLIST",    wordlist),
  174.   CO ("ALSO",        also),
  175.   VO ("FORTH",        &forth_list),
  176.   OY ("ONLY",        &only_list),
  177.   CO ("ORDER",        order),
  178.   CO ("PREVIOUS",    previous),
  179.   /* hook to activate all pfe extensions: */
  180.   VO ("EXTENSIONS",    &extensions_list),
  181.   CO ("DEFAULT-ORDER",    default_order),
  182.   CO ("RESET-ORDER",    reset_order),
  183. };
  184. COUNTWORDS (search, "Search-order + extensions");
  185.