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) {
172 if (_to_in < _in_input_buffer) _to_in++;
176 sp[0] = sp[sp[0] + 1];
181 current_block = _b_l_k++;
185 _input_buffer = (Char *) *sp++;
186 _in_input_buffer = BLOCK_SIZE;
187 *sp = FFLAG(_b_l_k && _input_buffer != NULL);
188 } else if (_source_id == 0) {
192 _input_buffer = _tib;
193 _in_input_buffer = *sp;
196 } else if (_source_id == -1) {
198 } else if (_env_file) {
199 if (fgets(_input_buffer, FILE_BUFFER_SIZE, (FILE *) _source_id)) {
200 _in_input_buffer = strlen(_input_buffer);
201 if (_in_input_buffer && _input_buffer[_in_input_buffer - 1] == '\n')
205 } else *--sp = FFLAG(0);
206 } else *--sp = FFLAG(0);
209 void _restore_input() {
213 _in_input_buffer = *sp++;
214 _input_buffer = (Char *) *sp++;
216 if (_source_id == 0) {
217 } else if (_source_id == -1) {
224 register Cell u = *sp++;
225 register Cell xu = sp[u];
227 for (i = u; i > 0; i--) sp[i] = sp[i - 1];
232 if (_source_id == 0) {
233 } else if (_source_id == -1) {
237 *--sp = (Cell) _input_buffer;
238 *--sp = _in_input_buffer;
256 register Cell r = *sp++;
260 _number_sign_greater();
270 void _u_greater_than() {
271 sp[1] = FFLAG((UCell) sp[1] > (UCell) sp[0]);
276 *--sp = (dspace_size - (_dp - dp0)) * sizeof(Cell);
280 register Cell n3 = *sp++;
281 register Cell n2 = *sp++;
282 register Cell n1 = *sp;
283 sp[0] = FFLAG((n2 < n3 && (n2 <= n1 && n1 < n3)) ||
284 (n2 > n3 && (n2 <= n1 || n1 < n3)));
288 _to_in = _in_input_buffer;
291 void _bracket_compile() {
295 compile_word(search_word(_dp + 1, *_dp));
299 create_definition(A_VALUE);
300 compile_cell((Cell) sp[0]);
305 void _paren_write_value_paren() {
306 register Cell *p = (Cell *) (*ip++);
315 register struct word_def *xt = (struct word_def *) *sp++;
316 if ((xt->class & A_WORD) == A_VALUE) {
317 if (_state == INTERPRET) xt->func[0] = (pfp) *sp++;
319 compile_cell((Cell) _paren_write_value_paren);
320 compile_cell((Cell) &xt->func[0]);
322 } else if (xt->class & A_WORD == A_LOCAL && _state == COMPILE) {
323 compile_cell((Cell) _paren_write_local_paren);
324 compile_cell((Cell) xt->func[0]);
331 void _paren_marker_paren() {
332 exec_marker((struct voc_marker *) ip++);
335 /**************************************************************************/
336 /* AUXILIARY FUNCTIONS ****************************************************/
337 /**************************************************************************/
339 void exec_marker(struct voc_marker *vm) {