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 * ------------------------------------------------------------------------
8 * Abstract: Core extension word set
22 /**************************************************************************/
23 /* VARIABLES **************************************************************/
24 /**************************************************************************/
28 /**************************************************************************/
29 /* WORDS ******************************************************************/
30 /**************************************************************************/
40 register Cell u = *sp++;
46 void _zero_not_equals() {
47 sp[0] = FFLAG(sp[0] != 0);
50 void _zero_greater() {
51 sp[0] = FFLAG(sp[0] > 0);
72 void _colon_no_name() {
73 register struct word_def *def;
75 def = (struct word_def *) _dp;
79 _dp += sizeof(struct word_def) - sizeof(Cell);
86 sp[1] = FFLAG(sp[0] != sp[1]);
91 compile_cell((Cell) _paren_question_do_paren);
95 *--sp = 1; /* e' un ?do */
98 void _paren_question_do_paren() {
99 if (sp[0] == sp[1]) ip += 1 + (Cell) *ip;
108 register Cell *dest = (Cell *) *sp++;
109 compile_cell((Cell) _branch);
110 compile_cell(dest - ((Cell *) _dp) - 1);
115 register Cell *patch;
116 compile_cell((Cell) _branch);
117 patch = (Cell *) _dp;
123 _dp = (Char *) WORD_PTR(_dp);
124 *patch = ((Cell *) _dp) - patch - 1;
125 compile_cell((Cell) _do_literal);
126 compile_cell((Cell) cur);
129 void _compile_comma() {
130 compile_word((struct word_def *) *sp++);
134 register UCell u = (UCell) *sp++;
135 register Char *addr = (Char *) *sp++;
136 if (u) memset(addr, 0, u);
148 struct voc_marker vm;
149 save_vocabulary(&vm);
150 create_definition(A_MARKER);
151 memcpy(_dp, &vm, sizeof(struct voc_marker));
152 _dp += ALIGN_PTR(sizeof(struct voc_marker));
162 register Char delim = (Char) *sp;
163 register Char *orig = &_input_buffer[_to_in];
165 while (_to_in < _in_input_buffer && _input_buffer[_to_in] != delim) {
171 if (_to_in < _in_input_buffer) _to_in++;
175 sp[0] = sp[sp[0] + 1];
180 current_block = _b_l_k++;
184 _input_buffer = (Char *) *sp++;
185 _in_input_buffer = BLOCK_SIZE;
186 *sp = FFLAG(_b_l_k && _input_buffer != NULL);
187 } else if (_source_id == 0) {
191 _input_buffer = _tib;
192 _in_input_buffer = *sp;
195 } else if (_source_id == -1) {
197 } else if (_env_file) {
198 if (fgets(_input_buffer, FILE_BUFFER_SIZE, (FILE *) _source_id)) {
199 _in_input_buffer = strlen(_input_buffer);
200 if (_in_input_buffer && _input_buffer[_in_input_buffer - 1] == '\n')
204 } else *--sp = FFLAG(0);
205 } else *--sp = FFLAG(0);
208 void _restore_input() {
212 _in_input_buffer = *sp++;
213 _input_buffer = (Char *) *sp++;
215 if (_source_id == 0) {
216 } else if (_source_id == -1) {
223 register Cell u = *sp++;
224 register Cell xu = sp[u];
226 for (i = u; i > 0; i--) sp[i] = sp[i - 1];
231 if (_source_id == 0) {
232 } else if (_source_id == -1) {
236 *--sp = (Cell) _input_buffer;
237 *--sp = _in_input_buffer;
255 register Cell r = *sp++;
259 _number_sign_greater();
269 void _u_greater_than() {
270 sp[1] = FFLAG((UCell) sp[1] > (UCell) sp[0]);
275 *--sp = (dspace_size - (_dp - dp0)) * sizeof(Cell);
279 register Cell n3 = *sp++;
280 register Cell n2 = *sp++;
281 register Cell n1 = *sp;
282 sp[0] = FFLAG((n2 < n3 && (n2 <= n1 && n1 < n3)) ||
283 (n2 > n3 && (n2 <= n1 || n1 < n3)));
287 _to_in = _in_input_buffer;
290 void _bracket_compile() {
294 compile_word(search_word(_dp + 1, *_dp));
298 create_definition(A_VALUE);
299 compile_cell((Cell) sp[0]);
304 void _paren_write_value_paren() {
305 register Cell *p = (Cell *) (*ip++);
314 register struct word_def *xt = (struct word_def *) *sp++;
315 if ((xt->class & A_WORD) == A_VALUE) {
316 if (_state == INTERPRET) xt->func[0] = (pfp) *sp++;
318 compile_cell((Cell) _paren_write_value_paren);
319 compile_cell((Cell) &xt->func[0]);
321 } else if (xt->class & A_WORD == A_LOCAL && _state == COMPILE) {
322 compile_cell((Cell) _paren_write_local_paren);
323 compile_cell((Cell) xt->func[0]);
330 void _paren_marker_paren() {
331 exec_marker((struct voc_marker *) ip++);
334 /**************************************************************************/
335 /* AUXILIARY FUNCTIONS ****************************************************/
336 /**************************************************************************/
338 void exec_marker(struct voc_marker *vm) {