git.gag.com Git - debian/yforth/blob - search.c

   1 /* yForth? - A Forth interpreter written in ANSI C
   2  * Copyright (C) 2012 Luca Padovani
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, either version 3 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16  * ------------------------------------------------------------------------
  17  * Module name:
  18  * Abstract:
  19  */
  20
  21 #include <stdlib.h>
  22 #include "core.h"
  23 #include "search.h"
  24
  25 /**************************************************************************/
  26 /* VARIABLES **************************************************************/
  27 /**************************************************************************/
  28
  29 struct vocabulary *list[WORD_LISTS];
  30 Cell top;               /* indice primo vocabolario sulla pila */
  31 struct vocabulary *voc; /* ptr al vocabolario usato per le definzioni */
  32 struct vocabulary *forth_wid;
  33
  34 /**************************************************************************/
  35 /* WORDS ******************************************************************/
  36 /**************************************************************************/
  37
  38 void _definitions() {
  39         voc = list[top];
  40 }
  41
  42 void _forth_wordlist() {
  43         *--sp = (Cell) forth_wid;
  44 }
  45
  46 void _get_current() {
  47         *--sp = (Cell) voc;
  48 }
  49
  50 void _get_order() {
  51         register Cell i;
  52         for (i = 0; i <= top; i++) *--sp = (Cell) list[i];
  53         *--sp = top;
  54 }
  55
  56 void _search_wordlist() {
  57         register struct vocabulary *wid = (struct vocabulary *) *sp++;
  58         register Cell len = *sp++;
  59         register Char *addr = (Char *) *sp;
  60         register struct word_def *xt = search_wordlist(addr, len, wid);
  61         set_find_stack(addr, xt);
  62         if (!*sp) *++sp = 0;
  63 }
  64
  65 void _set_current() {
  66         voc = (struct vocabulary *) *sp++;
  67 }
  68
  69 void _set_order() {
  70         register Cell n = *sp++;
  71         register int i;
  72         for (i = 0; i < n; i++)
  73                 if (i < WORD_LISTS) list[i] = (struct vocabulary *) *sp++;
  74                 else sp++;
  75         top = n - 1;
  76 }
  77
  78 void _wordlist() {
  79         register struct vocabulary *v;
  80         register int i;
  81         _align();
  82         v = (struct vocabulary *) _dp;
  83         _dp += sizeof(struct vocabulary);
  84         for (i = 0; i < VOC_HASH; i++) v->voc[i] = NULL;
  85         *--sp = (Cell) v;
  86 }
  87
  88
  89 /**************************************************************************/
  90 /* AUXILIARY FUNCTIONS ****************************************************/
  91 /**************************************************************************/
  92
  93 void save_vocabulary(struct voc_marker *vm) {
  94         register int i;
  95         for (i = 0; i < WORD_LISTS; i++) {
  96                 vm->list[i] = list[i];
  97                 if (list[i]) vm->v_list[i] = *list[i];
  98         }
  99         vm->top = top;
 100         vm->voc = voc;
 101         vm->_dp = _dp;
 102         vm->last = _last;
 103 }
 104
 105 void load_vocabulary(struct voc_marker *vm) {
 106         register int i;
 107         for (i = 0; i < WORD_LISTS; i++) {
 108                 list[i] = vm->list[i];
 109                 if (list[i]) *list[i] = vm->v_list[i];
 110         }
 111         top = vm->top;
 112         voc = vm->voc;
 113         _dp = vm->_dp;
 114         _last = vm->last;
 115 }