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

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