File: locals.c

package info (click to toggle)
yforth 0.2.1-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, jessie, jessie-kfreebsd, sid, stretch
  • size: 396 kB
  • ctags: 788
  • sloc: ansic: 4,426; makefile: 23
file content (153 lines) | stat: -rw-r--r-- 5,122 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
/* yForth? - A Forth interpreter written in ANSI C
 * Copyright (C) 2012 Luca Padovani
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 * ------------------------------------------------------------------------
 * Module name:     locals.c
 * Abstract:        locals word set
 */

/* Implementation notes
 * Local variables make use of the register "bp" of the Virtual Machine,
 * which stores the location, wihtin the return stack, of the first
 * local variable. All references to local variables are made relative
 * to this register. This implies that "bp" must be saved between calls of
 * words that make use of local variables, and every "exiting word" that
 * make a word terminate must reset it.
 * This is achieved by an auxiliary variable, called "local_defined", set
 * to 1 inside a colon definition when local variables are used.
 * Local names are stored dinamically by allocating a structure "word_def"
 * for any name. The function which searches the vocabulary for a particular
 * word has been modified accordingly so that the first try is always made
 * in this dynamic vocabulary, pointed by "first_local".
 */

#include <string.h>
#include <stdlib.h>
#include "yforth.h"
#include "core.h"
#include "locals.h"

/**************************************************************************/
/* VARIABLES **************************************************************/
/**************************************************************************/

static struct word_def *first_local;
static unsigned int local_defined;

/**************************************************************************/
/* WORDS ******************************************************************/
/**************************************************************************/

void _paren_local_paren() {
	register UCell u = (UCell) *sp++;
	register Char *s = (Char *) *sp++;
	declare_local(s, u);
}

/* restore "bp" register from return stack */
void _paren_bp_restore_paren() {
	rp += (Cell) *ip++;
	bp = (Cell *) *rp++;
}

/* save "bp" register on return stack */
void _paren_bp_save_paren() {
	*--rp = (Cell) bp;
	bp = rp - 1;
}

/* push on the data stack the value of i-th local variable, where i is the
 * Cell value pointed to by "ip" when "_paren_read_local_paren" is called.
 */
void _paren_read_local_paren() {
	register UCell offset = (UCell) *ip++;
	*--sp = *(bp - offset);
}

/* update the i-th local variable with the Cell value on the data stack.
 * See "_paren_read_local_paren" for a comment about the value "i"
 */
void _paren_write_local_paren() {
	register UCell offset = (UCell) *ip++;
	*(bp - offset) = *sp++;
}

/**************************************************************************/
/* AUXILIARY FUNCTIONS ****************************************************/
/**************************************************************************/

/* clear_locals: called inside the compilation of a colon definition to
 * compile the code that restore "bp" and free the dynamic vocabulary of
 * local names
 */
void clear_locals() {
	if (local_defined) {
		compile_cell((Cell) _paren_bp_restore_paren);
		compile_cell((Cell) local_defined);	/* # di variabili locali */
	}
	free_locals();
	local_defined = 0;
}

/* free_locals: release the dynamic vocabulary. Called by "clear_locals". */
void free_locals() {
	register struct word_def *p = first_local, *p1;
	while (p) {
		free(p->name);
		p1 = p->link;
		free(p);
		p = p1;
	}
	first_local = NULL;
}

void init_locals() {
}

/* declare_local: declare a new local variable. If it's the first local
 * variable for the current colon definition, compile the code to save
 * the register "bp"
 */
void declare_local(Char *s, UCell u) {
	struct word_def *p = (struct word_def *) malloc(sizeof(struct word_def));
	if (p) {
		p->name = (Char *) malloc(u + 1);
		if (p->name) {
			p->name[0] = (Char) u;
			memcpy(p->name + 1, s, u);
			p->link = first_local;
			p->class = A_LOCAL;
			p->func[0] = (pfp) (local_defined++);
			if (!first_local) compile_cell((Cell) _paren_bp_save_paren);
			first_local = p;
		} else free(p);
	}
}

/* get_first_local: interface function that returns a pointer to the first
 * local name defined (actually is the last name, since names are stored
 * in reverse order for efficiency, but this doesn't matter)
 */
struct word_def *get_first_local() {
	return (first_local);
}

/* locals_defined: interface function that returns true if current word
 * has some local name defined
 */
int locals_defined() {
	return (local_defined);
}