git.gag.com Git - debian/yforth/blob - locals.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:     locals.c
  18  * Abstract:        locals word set
  19  */
  20
  21 /* Implementation notes
  22  * Local variables make use of the register "bp" of the Virtual Machine,
  23  * which stores the location, wihtin the return stack, of the first
  24  * local variable. All references to local variables are made relative
  25  * to this register. This implies that "bp" must be saved between calls of
  26  * words that make use of local variables, and every "exiting word" that
  27  * make a word terminate must reset it.
  28  * This is achieved by an auxiliary variable, called "local_defined", set
  29  * to 1 inside a colon definition when local variables are used.
  30  * Local names are stored dinamically by allocating a structure "word_def"
  31  * for any name. The function which searches the vocabulary for a particular
  32  * word has been modified accordingly so that the first try is always made
  33  * in this dynamic vocabulary, pointed by "first_local".
  34  */
  35
  36 #include <string.h>
  37 #include <stdlib.h>
  38 #include "yforth.h"
  39 #include "core.h"
  40 #include "locals.h"
  41
  42 /**************************************************************************/
  43 /* VARIABLES **************************************************************/
  44 /**************************************************************************/
  45
  46 static struct word_def *first_local;
  47 static unsigned int local_defined;
  48
  49 /**************************************************************************/
  50 /* WORDS ******************************************************************/
  51 /**************************************************************************/
  52
  53 void _paren_local_paren() {
  54         register UCell u = (UCell) *sp++;
  55         register Char *s = (Char *) *sp++;
  56         declare_local(s, u);
  57 }
  58
  59 /* restore "bp" register from return stack */
  60 void _paren_bp_restore_paren() {
  61         rp += (Cell) *ip++;
  62         bp = (Cell *) *rp++;
  63 }
  64
  65 /* save "bp" register on return stack */
  66 void _paren_bp_save_paren() {
  67         *--rp = (Cell) bp;
  68         bp = rp - 1;
  69 }
  70
  71 /* push on the data stack the value of i-th local variable, where i is the
  72  * Cell value pointed to by "ip" when "_paren_read_local_paren" is called.
  73  */
  74 void _paren_read_local_paren() {
  75         register UCell offset = (UCell) *ip++;
  76         *--sp = *(bp - offset);
  77 }
  78
  79 /* update the i-th local variable with the Cell value on the data stack.
  80  * See "_paren_read_local_paren" for a comment about the value "i"
  81  */
  82 void _paren_write_local_paren() {
  83         register UCell offset = (UCell) *ip++;
  84         *(bp - offset) = *sp++;
  85 }
  86
  87 /**************************************************************************/
  88 /* AUXILIARY FUNCTIONS ****************************************************/
  89 /**************************************************************************/
  90
  91 /* clear_locals: called inside the compilation of a colon definition to
  92  * compile the code that restore "bp" and free the dynamic vocabulary of
  93  * local names
  94  */
  95 void clear_locals() {
  96         if (local_defined) {
  97                 compile_cell((Cell) _paren_bp_restore_paren);
  98                 compile_cell((Cell) local_defined);     /* # di variabili locali */
  99         }
 100         free_locals();
 101         local_defined = 0;
 102 }
 103
 104 /* free_locals: release the dynamic vocabulary. Called by "clear_locals". */
 105 void free_locals() {
 106         register struct word_def *p = first_local, *p1;
 107         while (p) {
 108                 free(p->name);
 109                 p1 = p->link;
 110                 free(p);
 111                 p = p1;
 112         }
 113         first_local = NULL;
 114 }
 115
 116 void init_locals() {
 117 }
 118
 119 /* declare_local: declare a new local variable. If it's the first local
 120  * variable for the current colon definition, compile the code to save
 121  * the register "bp"
 122  */
 123 void declare_local(Char *s, UCell u) {
 124         struct word_def *p = (struct word_def *) malloc(sizeof(struct word_def));
 125         if (p) {
 126                 p->name = (Char *) malloc(u + 1);
 127                 if (p->name) {
 128                         p->name[0] = (Char) u;
 129                         memcpy(p->name + 1, s, u);
 130                         p->link = first_local;
 131                         p->class = A_LOCAL;
 132                         p->func[0] = (pfp) (local_defined++);
 133                         if (!first_local) compile_cell((Cell) _paren_bp_save_paren);
 134                         first_local = p;
 135                 } else free(p);
 136         }
 137 }
 138
 139 /* get_first_local: interface function that returns a pointer to the first
 140  * local name defined (actually is the last name, since names are stored
 141  * in reverse order for efficiency, but this doesn't matter)
 142  */
 143 struct word_def *get_first_local() {
 144         return (first_local);
 145 }
 146
 147 /* locals_defined: interface function that returns true if current word
 148  * has some local name defined
 149  */
 150 int locals_defined() {
 151         return (local_defined);
 152 }
 153